Session AODV

Theory Aodv_Basic

(*  Title:       Aodv_Basic.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Basic data types and constants"

theory Aodv_Basic
imports Main AWN.AWN_SOS
begin

text ‹These definitions are shared with all variants.›

type_synonym rreqid = nat
type_synonym sqn = nat

datatype k = Known | Unknown
abbreviation kno where "kno  Known"
abbreviation unk where "unk  Unknown"

datatype p = NoRequestRequired | RequestRequired
abbreviation noreq where "noreq  NoRequestRequired"
abbreviation req where "req  RequestRequired"

datatype f = Valid | Invalid
abbreviation val where "val  Valid"
abbreviation inv where "inv  Invalid"

lemma not_ks [simp]:                                      
   "(x  kno) = (x = unk)"
   "(x  unk) = (x = kno)"
  by (cases x, clarsimp+)+

lemma not_ps [simp]:
  "(x  noreq) = (x = req)"
  "(x  req) = (x = noreq)"
  by (cases x, clarsimp+)+

lemma not_ffs [simp]:
  "(x  val) = (x = inv)"
  "(x  inv) = (x = val)"
  by (cases x, clarsimp+)+

end

Theory Aodv_Data

(*  Title:       Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Predicates and functions used in the AODV model"

theory Aodv_Data
imports Aodv_Basic
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a 6-tuple, @{term "(dsn, dsk, flag, hops, nhip, pre)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, @{term nhip} is the
  next hop toward the destination, and @{term pre} is the set of `precursor nodes'--those
  interested in hearing about changes to the route.
›

type_synonym r = "sqn × k × f × nat × ip × ip set"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip, _). nhip"

definition proj7 :: "r  ip set" ("π7")
  where "π7  λ(_, _, _, _, _, pre). pre"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip, pre) = dsn"
  "π3(dsn, dsk, flag, hops, nhip, pre) = dsk"
  "π4(dsn, dsk, flag, hops, nhip, pre) = flag"
  "π5(dsn, dsk, flag, hops, nhip, pre) = hops"
  "π6(dsn, dsk, flag, hops, nhip, pre) = nhip"
  "π7(dsn, dsk, flag, hops, nhip, pre) = pre"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def proj7_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

abbreviation precs :: "rt  ip  ip set"
   where "precs rt dip  map_option π7 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip, pre)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip, pre)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip, pre)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop pre
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop, pre)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating Precursor Lists"

definition addpre :: "r  ip set  r"
  where "addpre r npre  let (dsn, dsk, flag, hops, nhip, pre) = r in
                          (dsn, dsk, flag, hops, nhip, pre  npre)"

lemma proj2_addpre:
  fixes v pre
  shows "π2(addpre v pre) = π2(v)"
  unfolding addpre_def by (cases v) simp

lemma proj3_addpre:
  fixes v pre
  shows "π3(addpre v pre) = π3(v)"
  unfolding addpre_def by (cases v) simp

lemma proj4_addpre:
  fixes v pre
  shows "π4(addpre v pre) = π4(v)"
  unfolding addpre_def by (cases v) simp

lemma proj5_addpre:
  fixes v pre
  shows "π5(addpre v pre) = π5(v)"
  unfolding addpre_def by (cases v) simp

lemma proj6_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π6(addpre v npre) = π6(v)"
  unfolding addpre_def by (cases v) simp

lemma proj7_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π7(addpre v npre) = π7(v)  npre"
  unfolding addpre_def by (cases v) simp

lemma addpre_empty: "addpre r {} = r"
  unfolding addpre_def by simp

lemma addpre_r:
  "addpre (dsn, dsk, fl, hops, nhip, pre) npre = (dsn, dsk, fl, hops, nhip, pre  npre)"
  unfolding addpre_def by simp

lemmas addpre_simps [simp] = proj2_addpre proj3_addpre proj4_addpre proj5_addpre
                             proj6_addpre proj7_addpre addpre_empty addpre_r

definition addpreRT :: "rt  ip  ip set  rt"
  where "addpreRT rt dip npre 
           map_option (λs. rt (dip  addpre s npre)) (σroute(rt, dip))"

lemma snd_addpre [simp]:
  "dsn dsn' v pre. (dsn, snd(addpre (dsn', v) pre)) = addpre (dsn, v) pre"
  unfolding addpre_def by clarsimp

lemma proj2_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π2(the (the (addpreRT rt ip' npre) ip)) = π2(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj3_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π3(the (the (addpreRT rt ip' npre) ip)) = π3(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj5_addpreRT [simp]:
  "rt dip ip npre. dipkD(rt)  π5(the (the (addpreRT rt dip npre) ip)) = π5(the (rt ip))"
  unfolding addpreRT_def by auto

lemma flag_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "flag (the (addpreRT rt dip pre)) ip = flag rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

  lemma kD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "kD (the (addpreRT rt dip npre)) = kD rt"
  unfolding kD_def addpreRT_def
  using assms [THEN kD_Some]
  by clarsimp blast

lemma vD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "vD (the (addpreRT rt dip npre)) = vD rt"
  unfolding vD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma iD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "iD (the (addpreRT rt dip npre)) = iD rt"
  unfolding iD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma nhop_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "nhop (the (addpreRT rt dip pre)) ip = nhop rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqn_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "sqn (the (addpreRT rt dip pre)) ip = sqn rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma dhops_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "dhops (the (addpreRT rt dip pre)) ip = dhops rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqnf_addpreRT [simp]:
  "ip dip. ipkD(rt ξ)  sqnf (the (addpreRT (rt ξ) ip npre)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def addpreRT_def by auto

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip pre
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip pre. update_arg_wf (0, unk, val, Suc 0, nhip, pre)"
  "n hops nhip pre. update_arg_wf (Suc n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip pre. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip pre. P (0, unk, val, Suc 0, nhip, pre)"
      and c2: "dsn hops nhip pre. dsn > 0  P (dsn, kno, val, hops, nhip, pre)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip pre
    where *: "r = (dsn, dsk, flag, hops, nhip, pre)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip, pre)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  addpre r (π7(s)))
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  addpre r (π7(s)))
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (addpre r (π7(s)))))
                    else rt (ip  addpre s (π7(r)))"

lemma update_simps [simp]:
  fixes r s nrt nr nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr  addpre r (π7(s))"
      and "nr'  (π2(s), π3(nr), π4(nr), π5(nr), π6(nr), π7(nr))"
      and "ns  addpre s (π7(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  nr)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  ns)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  nr)"
      unfolding update_def nr_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def nr_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  ns)"
      unfolding update_def ns_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r), π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip pre
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip' pre'
      where req: "r = (dsn', dsk', fl', hops', nhip', pre')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r),
                                            π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  addpre r (π7(the (rt ip)))))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r),
                        π7(addpre r (π7(the (rt ip)))))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  addpre (the (rt ip)) (π7(r))))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip, pre)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip, {})"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip, {})) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip, {})
              rt(dip  addpre (the (rt dip)) (π7 (dsn, dsk, flag, hops, nhip, {})))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip pre
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip, pre)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip, pre) = 0) = (π3 (dsn, dsk, val, hops, nhip, pre) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip pre
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip, pre)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip pre
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip, pre)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip pre. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip, {})) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops npre.
   the (nhop (update rt dip (dsn, unk, val, hops, ip, npre)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip, {})  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip, {}))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip, {})  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip, {})
          ¬P (update rt ip (dsn, dsk, flag, hops, sip, {}))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   sqn (update rt dip (dsn, kno, flg, hops, sip, {})) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   sqnf (update rt dip (dsn, dsk, flg, hops, sip, {})) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops npre. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip, npre)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   π3(the (update rt dip (dsn, dsk, flg, hops, sip, {}) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    the (nhop (update rt ip (dsn, kno, val, hops, nhip, {})) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   the (flag (update rt dip (dsn, kno, flg, hops, sip, {})) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip pre
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip, pre)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip, pre))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip pre.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip, pre))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip, pre), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip, pre)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj7_invalidate [simp]:
  "dip. π7(the ((invalidate rt dests) dip)) = π7(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip, pre)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))
            pre = π7(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto


lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Route Requests"

text ‹Generate a fresh route request identifier.›

definition nrreqid :: "(ip × rreqid) set  ip  rreqid"
  where "nrreqid rreqs ip  Max ({n. (ip, n)  rreqs}  {0}) + 1"

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory Aodv_Message

(*  Title:       Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "AODV protocol messages"

theory Aodv_Message
imports Aodv_Basic
begin

datatype msg =
    Rreq nat rreqid ip sqn k ip sqn ip
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × rreqid × ip × sqn × k × ip × sqn × ip  msg"
  where "rreq  λ(hops, rreqid, dip, dsn, dsk, oip, osn, sip).
                    Rreq hops rreqid dip dsn dsk oip osn sip"

lemma rreq_simp [simp]:
  "rreq(hops, rreqid, dip, dsn, dsk, oip, osn, sip) =  Rreq hops rreqid dip dsn dsk oip osn sip"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops rreqid dip dsn dsk oip osn sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory Aodv

(*  Title:       Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The AODV protocol"

theory Aodv
imports Aodv_Data Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × rreqid) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"
  pre    :: "ip set"
  rreqid :: "rreqid"
  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),
         pre    = (SOME x. True),
         rreqid = (SOME x. True),
         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),
    pre    := (SOME x. True),
    rreqid := (SOME x. True),
    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
                       { ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' rreqid' dip' dsn' dsk' oip' osn' sip'.
               msg ξ = Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
               ξ' = ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, rreqid, dip, dsn, dsk, oip, osn, sip) = args ξ in
         (clear_locals ξ)  hops := hops, rreqid := rreqid, dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREQ(λξ. (hops ξ, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqid := nrreqid (rreqs ξ) (ip ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, rreqid ξ)} 
         broadcast(λξ. rreq(0, rreqid ξ, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ),
                            ip ξ, sn ξ, ip ξ)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
           ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                   then (dests ξ) rip else None) 
           groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             groupcast(λξ. the (precs (rt ξ) (dip ξ)),
                       λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)], ip ξ)). AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, rreqid ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, rreqid ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, rreqid ξ)} 
       (
         ξ. dip ξ = ip ξ
           ξ. ξ  sn := max (sn ξ) (dsn ξ) 
           unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
          ξ. dip ξ  ip ξ
         (
           ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {sip ξ}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                         sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
             broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                dsk ξ, oip ξ, osn ξ, ip ξ)).
             AODV()
         )
       ))"

| "ΓAODV PRrep = labelled PRrep (
     ξ. rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
     (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {the (nhop (rt ξ) (oip ξ))}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ)))
                                               {the (nhop (rt ξ) (oip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(hops ξ + 1, dip ξ, dsn ξ, oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)
             AODV()
         )
       )
     )
      ξ. rt ξ = update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
         AODV()
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
     ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                             then (dests ξ) rip else None) 
     groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV())"

declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory Aodv_Predicates

(*  Title:       Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant assumptions and properties"

theory Aodv_Predicates
imports Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ _ ipc  ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                          msg_sender (Rreq hops rreqid dip dsn dsk oip osn sip) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc _ dipc _ _ oipc _ sipc  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_zhops (Rreq hops rreqid dip dsn dsk oip osn sip) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq _ _ _ _ _ _ osnc _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc _ _ _ _ oipc osnc ipcc  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_fresh crt (Rreq hops rreqid dip dsn dsk oip osn sip) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                           rerr_invalid crt (Rreq hops rreqid dip dsn dsk oip osn sip) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory Fresher

(*  Title:       Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Quality relations between routes"

theory Fresher
imports Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (0, dsk, flag, hops, nhip, pre) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, val, hops, nhip, pre) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, inv, hops, nhip, pre) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (dsn, dsk, flag, hops, nhip, pre)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip pre
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip, pre))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip, pre))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip, pre))"
  using assms by (cases flag) auto

lemma nsqnr_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqnr (the (the (addpreRT rt dip npre) dip')) = nsqnr (the (rt dip'))"
  unfolding addpreRT_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    nsqn (update rt ip (dsn, kno, val, hops, nhip, {})) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqn (the (addpreRT rt dip npre)) dip' = nsqn rt dip'"
  unfolding addpreRT_def nsqn_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip pre rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip, pre)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip pre
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip, pre)"
      unfolding invalidate_def by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip' pre pre'
  shows "(dsn, dsk, flag, hops, nhip, pre)  (dsn, dsk', flag, hops, nhip', pre')"
  unfolding fresher_def by (cases flag) simp_all

lemma addpre_fresher [simp]: "r npre. r  (addpre r npre)"
  by clarsimp

subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn pren
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn, pren)"
      by (metis prod_cases6)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn, pren)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip pre
        from hopsn  1 have "pre'. (dsnn, dskn, fn, hopsn, nhipn, pren)
                                         (dsnn, unk, val, Suc 0, nhip, pre')"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (0, unk, val, Suc 0, nhip, pre) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip pre
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (dsn, kno, val, hops, nhip, pre) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]

lemma rt_fresh_as_addpreRT [simp]:
  assumes "ipkD(rt)"
    shows "rtdip the (addpreRT rt ip npre)"
  using assms [THEN kD_Some] by (auto simp: addpreRT_def)

lemmas rt_fresher_addpreRT [simp] = rt_fresh_as_addpreRT [THEN rt_fresh_asD1]

subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma addpreRT_strictly_fresher [simp]:
  assumes "dip  kD(rt)"
    shows "(the (addpreRT rt dip npre)ip rt2) = (rtip rt2)"
  using assms unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "update rt dip (osn, kno, val, hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip, {})"
    shows "update rt dip (osn, kno, val, Suc hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory Seq_Invariants

(*  Title:       Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant proofs on individual processes"

theory Seq_Invariants
imports AWN.Invariants Aodv Aodv_Data Aodv_Predicates Fresher

begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:1}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms

lemma rrep_1_update_changes:
  "paodv i  onl ΓAODV (λ(ξ, l). (l = PRrep-:1 
                        rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})))"
  by inv_cterms

lemma addpreRT_partly_welldefined:
  "paodv i 
     onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  {PRrep-:2..PRrep-:6}  dip ξ  kD (rt ξ))
                       (l  {PRreq-:3..PRreq-:17}  oip ξ  kD (rt ξ)))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip, {})"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip) = ip
                  the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip)  kD (rt ξ))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                              onl_invariant_sterms [OF aodv_wf addpreRT_partly_welldefined]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.22: needed in Proposition 7.4›

lemma addpreRT_welldefined:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  kD (rt ξ)) 
                               (l = PRreq-:17  oip ξ  kD (rt ξ))                   
                               (l = PRrep-:5   dip ξ  kD (rt ξ)) 
                               (l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD (rt ξ)))"
  (is "_  onl ΓAODV ?P")
  unfolding invariant_def
  proof
    fix s
    assume "s  reachable (paodv i) TT"
    then obtain ξ p where "s = (ξ, p)"
                      and "(ξ, p)  reachable (paodv i) TT"
      by (metis prod.exhaust)
    have "onl ΓAODV ?P (ξ, p)"
    proof (rule onlI)
      fix l
      assume "l  labels ΓAODV p"
      with (ξ, p)  reachable (paodv i) TT›
        have I1: "l  {PRreq-:16..PRreq-:18}  dip ξ  kD(rt ξ)"
         and I2: "l = PRreq-:17  oip ξ  kD(rt ξ)"
         and I3: "l  {PRrep-:2..PRrep-:6}   dip ξ  kD(rt ξ)"
         by (auto dest!: invariantD [OF addpreRT_partly_welldefined])
      moreover from (ξ, p)  reachable (paodv i) TT› l  labels ΓAODV p and I3
        have "l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD(rt ξ)"
          by (auto dest!: invariantD [OF includes_nhip])
      ultimately show "?P (ξ, l)"
        by simp
    qed
    with s = (ξ, p) show "onl ΓAODV ?P s"
      by simp
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                 simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:19}
                                  {PPkt-:7..PPkt-:11}
                                  {PRreq-:9..PRreq-:13}
                                  {PRreq-:21..PRreq-:25}
                                  {PRrep-:10..PRrep-:14}
                                  {PRerr-:1..PRerr-:5}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:5, PRreq-:6}  dip ξ = ip ξ)
                             (l  {PRreq-:15..PRreq-:18}  dip ξ  ip ξ))"
  proof (inv_cterms, elim conjE)
    fix l ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:17}λξ. ξrt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}) p'
               sterms ΓAODV pp"
       and "l = PRreq-:17"
       and "dip ξ  vD (rt ξ)"
    from this(1-3) have "oip ξ  kD (rt ξ)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRreq-:17"])
    with ‹dip ξ  vD (rt ξ)
      show "dip ξ  vD (the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}))" by simp
  qed

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:18}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:18"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip, {})) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip, {})) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                            onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:16..PRreq-:18}  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3, PRreq-:4, PRreq-:15, PRreq-:27}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {}) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:2..PRrep-:7}  (dip ξ  kD(rt ξ)
                                         sqn (rt ξ) (dip ξ) = dsn ξ
                                         the (dhops (rt ξ) (dip ξ)) = Suc (hops ξ)
                                         the (flag (rt ξ) (dip ξ)) = val
                                         the (nhop (rt ξ) (dip ξ))  kD (rt ξ))))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rrep_1_update_changes]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD])

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9,
                                            PRreq-:21, PRrep-:10, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:19}
                               {PPkt-:8..PPkt-:11}
                               {PRreq-:10..PRreq-:13}
                               {PRreq-:22..PRreq-:25}
                               {PRrep-:11..PRrep-:14}
                               {PRerr-:2..PRerr-:5}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:14  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9, PRreq-:21, PRrep-:10}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf addpreRT_welldefined [THEN invariant_restrict_inD]])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:1}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory Quality_Increases

(*  Title:       Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The quality increases predicate"

theory Quality_Increases
imports Aodv_Predicates Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc _ _ _ _ oipc osnc sipc  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops rreqid dip dsn dsk oip osn sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops rreqid dip dsn dsk oip osn sip)"
      and "rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip)"
  shows "msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops rreqid dip dsn dsk oip osn sip
    assume [simp]: "m = Rreq hops rreqid dip dsn dsk oip osn sip"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory OAodv

(*  Title:       OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory OAodv
imports Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory Global_Invariants

(*  Title:       Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Global invariant proofs over sequential processes"

theory Global_Invariants
imports Seq_Invariants
        Aodv_Predicates
        Fresher
        Quality_Increases
        AWN.OAWN_Convert
        OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed


text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis
        by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas oaddpreRT_welldefined =
         open_seq_invariant [OF addpreRT_welldefined initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i), {}))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i), {}))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by auto
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip, {})) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip, {})) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}) = rt (σ i)"

          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory Loop_Freedom

(*  Title:       Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Routing graphs and loop freedom"

theory Loop_Freedom
imports Aodv_Predicates Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops pre.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip', pre)})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops pre. r dip = Some (dsn, dsk, val, hops, ip', pre)))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory Aodv_Loop_Freedom

(*  Title:       Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting Global_Invariants Loop_Freedom
begin

subsection ‹Lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory A_Norreqid

(*  Title:       variants/a_norreqid/A_Norreqid.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible A_Norreqid
imports "../../Aodv_Basic"
begin

chapter "Variant A: Skipping the RREQ ID"

text ‹
  Explanation~\cite[\textsection 10.1]{FehnkerEtAl:AWN:2013}:
  AODV does not need the route request identifier. This number, in 
  combination with the IP address of the originator, is used to identify 
  every RREQ message in a unique way. This variant shows that the 
  combination of the originator's IP address and its sequence number is just 
  as suited to uniquely determine the route request to which the message 
  belongs. Hence, the route request identifier field is not required. This 
  can then reduce the size of the RREQ message.
›

end %invisible

Theory A_Aodv_Data

(*  Title:       variants/a_norreqid/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Predicates and functions used in the AODV model"

theory A_Aodv_Data
imports A_Norreqid
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a 6-tuple, @{term "(dsn, dsk, flag, hops, nhip, pre)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, @{term nhip} is the
  next hop toward the destination, and @{term pre} is the set of `precursor nodes'--those
  interested in hearing about changes to the route.
›

type_synonym r = "sqn × k × f × nat × ip × ip set"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip, _). nhip"

definition proj7 :: "r  ip set" ("π7")
  where "π7  λ(_, _, _, _, _, pre). pre"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip, pre) = dsn"
  "π3(dsn, dsk, flag, hops, nhip, pre) = dsk"
  "π4(dsn, dsk, flag, hops, nhip, pre) = flag"
  "π5(dsn, dsk, flag, hops, nhip, pre) = hops"
  "π6(dsn, dsk, flag, hops, nhip, pre) = nhip"
  "π7(dsn, dsk, flag, hops, nhip, pre) = pre"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def proj7_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

abbreviation precs :: "rt  ip  ip set"
   where "precs rt dip  map_option π7 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip, pre)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip, pre)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip, pre)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop pre
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop, pre)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating Precursor Lists"

definition addpre :: "r  ip set  r"
  where "addpre r npre  let (dsn, dsk, flag, hops, nhip, pre) = r in
                          (dsn, dsk, flag, hops, nhip, pre  npre)"

lemma proj2_addpre:
  fixes v pre
  shows "π2(addpre v pre) = π2(v)"
  unfolding addpre_def by (cases v) simp

lemma proj3_addpre:
  fixes v pre
  shows "π3(addpre v pre) = π3(v)"
  unfolding addpre_def by (cases v) simp

lemma proj4_addpre:
  fixes v pre
  shows "π4(addpre v pre) = π4(v)"
  unfolding addpre_def by (cases v) simp

lemma proj5_addpre:
  fixes v pre
  shows "π5(addpre v pre) = π5(v)"
  unfolding addpre_def by (cases v) simp

lemma proj6_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π6(addpre v npre) = π6(v)"
  unfolding addpre_def by (cases v) simp

lemma proj7_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π7(addpre v npre) = π7(v)  npre"
  unfolding addpre_def by (cases v) simp

lemma addpre_empty: "addpre r {} = r"
  unfolding addpre_def by simp

lemma addpre_r:
  "addpre (dsn, dsk, fl, hops, nhip, pre) npre = (dsn, dsk, fl, hops, nhip, pre  npre)"
  unfolding addpre_def by simp

lemmas addpre_simps [simp] = proj2_addpre proj3_addpre proj4_addpre proj5_addpre
                             proj6_addpre proj7_addpre addpre_empty addpre_r

definition addpreRT :: "rt  ip  ip set  rt"
  where "addpreRT rt dip npre 
           map_option (λs. rt (dip  addpre s npre)) (σroute(rt, dip))"

lemma snd_addpre [simp]:
  "dsn dsn' v pre. (dsn, snd(addpre (dsn', v) pre)) = addpre (dsn, v) pre"
  unfolding addpre_def by clarsimp

lemma proj2_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π2(the (the (addpreRT rt ip' npre) ip)) = π2(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj3_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π3(the (the (addpreRT rt ip' npre) ip)) = π3(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj5_addpreRT [simp]:
  "rt dip ip npre. dipkD(rt)  π5(the (the (addpreRT rt dip npre) ip)) = π5(the (rt ip))"
  unfolding addpreRT_def by auto

lemma flag_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "flag (the (addpreRT rt dip pre)) ip = flag rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

  lemma kD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "kD (the (addpreRT rt dip npre)) = kD rt"
  unfolding kD_def addpreRT_def
  using assms [THEN kD_Some]
  by clarsimp blast

lemma vD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "vD (the (addpreRT rt dip npre)) = vD rt"
  unfolding vD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma iD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "iD (the (addpreRT rt dip npre)) = iD rt"
  unfolding iD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma nhop_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "nhop (the (addpreRT rt dip pre)) ip = nhop rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqn_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "sqn (the (addpreRT rt dip pre)) ip = sqn rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma dhops_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "dhops (the (addpreRT rt dip pre)) ip = dhops rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqnf_addpreRT [simp]:
  "ip dip. ipkD(rt ξ)  sqnf (the (addpreRT (rt ξ) ip npre)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def addpreRT_def by auto

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip pre
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip pre. update_arg_wf (0, unk, val, Suc 0, nhip, pre)"
  "n hops nhip pre. update_arg_wf (Suc n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip pre. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip pre. P (0, unk, val, Suc 0, nhip, pre)"
      and c2: "dsn hops nhip pre. dsn > 0  P (dsn, kno, val, hops, nhip, pre)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip pre
    where *: "r = (dsn, dsk, flag, hops, nhip, pre)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip, pre)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  addpre r (π7(s)))
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  addpre r (π7(s)))
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (addpre r (π7(s)))))
                    else rt (ip  addpre s (π7(r)))"

lemma update_simps [simp]:
  fixes r s nrt nr nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr  addpre r (π7(s))"
      and "nr'  (π2(s), π3(nr), π4(nr), π5(nr), π6(nr), π7(nr))"
      and "ns  addpre s (π7(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  nr)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  ns)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  nr)"
      unfolding update_def nr_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def nr_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  ns)"
      unfolding update_def ns_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r), π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip pre
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip' pre'
      where req: "r = (dsn', dsk', fl', hops', nhip', pre')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r),
                                            π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  addpre r (π7(the (rt ip)))))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r),
                        π7(addpre r (π7(the (rt ip)))))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  addpre (the (rt ip)) (π7(r))))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip, pre)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip, {})"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip, {})) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip, {})
              rt(dip  addpre (the (rt dip)) (π7 (dsn, dsk, flag, hops, nhip, {})))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip pre
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip, pre)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip, pre) = 0) = (π3 (dsn, dsk, val, hops, nhip, pre) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip pre
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip, pre)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip pre
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip, pre)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip pre. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip, {})) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops npre.
   the (nhop (update rt dip (dsn, unk, val, hops, ip, npre)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip, {})  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip, {}))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip, {})  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip, {})
          ¬P (update rt ip (dsn, dsk, flag, hops, sip, {}))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   sqn (update rt dip (dsn, kno, flg, hops, sip, {})) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   sqnf (update rt dip (dsn, dsk, flg, hops, sip, {})) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops npre. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip, npre)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   π3(the (update rt dip (dsn, dsk, flg, hops, sip, {}) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    the (nhop (update rt ip (dsn, kno, val, hops, nhip, {})) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   the (flag (update rt dip (dsn, kno, flg, hops, sip, {})) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip pre
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip, pre)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip, pre))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip pre.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip, pre))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip, pre), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip, pre)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj7_invalidate [simp]:
  "dip. π7(the ((invalidate rt dests) dip)) = π7(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

subsection "Route Requests"

lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip, pre)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))
            pre = π7(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto


lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory A_Aodv_Message

(*  Title:       variants/a_norreqid/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "AODV protocol messages"

theory A_Aodv_Message
imports A_Norreqid
begin

datatype msg =
    Rreq nat ip sqn k ip sqn ip
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)  
end
 
text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × ip × sqn × k × ip × sqn × ip  msg"
  where "rreq  λ(hops, dip, dsn, dsk, oip, osn, sip).
                    Rreq hops dip dsn dsk oip osn sip"

lemma rreq_simp [simp]:
  "rreq(hops, dip, dsn, dsk, oip, osn, sip) =  Rreq hops dip dsn dsk oip osn sip"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops dip dsn dsk oip osn sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory A_Aodv

(*  Title:       variants/a_norreqid/Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The AODV protocol"

theory A_Aodv
imports A_Aodv_Data A_Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × sqn) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"
  pre    :: "ip set"
  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),
         pre    = (SOME x. True),
         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),
    pre    := (SOME x. True),
    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' dip' dsn' dsk' oip' osn' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' rreqid' dip' dsn' dsk' oip' osn' sip'.
               msg ξ = Rreq hops' dip' dsn' dsk' oip' osn' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, dip, dsn, dsk, oip, osn, sip) = args ξ in
         (clear_locals ξ)  hops := hops,  dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREQ(λξ. (hops ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, sn ξ)} 
         broadcast(λξ. rreq(0, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ),
                            ip ξ, sn ξ, ip ξ)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
           ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                   then (dests ξ) rip else None) 
           groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             groupcast(λξ. the (precs (rt ξ) (dip ξ)),
                       λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)], ip ξ)). AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, osn ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, osn ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, osn ξ)} 
       (
         ξ. dip ξ = ip ξ
           ξ. ξ  sn := max (sn ξ) (dsn ξ) 
           unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
          ξ. dip ξ  ip ξ
         (
           ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {sip ξ}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                         sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
             broadcast(λξ. rreq(hops ξ + 1, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                dsk ξ, oip ξ, osn ξ, ip ξ)).
             AODV()
         )
       ))"

| "ΓAODV PRrep = labelled PRrep (
     ξ. rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
     (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {the (nhop (rt ξ) (oip ξ))}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ)))
                                               {the (nhop (rt ξ) (oip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(hops ξ + 1, dip ξ, dsn ξ, oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)
             AODV()
         )
       )
     )
      ξ. rt ξ = update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
         AODV()
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
     ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                             then (dests ξ) rip else None) 
     groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV())"

declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory A_Aodv_Predicates

(*  Title:       variants/a_norreqid/Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant assumptions and properties"

theory A_Aodv_Predicates
imports A_Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ ipc  ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops dip dsn dsk oip osn sip.
                          msg_sender (Rreq hops dip dsn dsk oip osn sip) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc dipc _ _ oipc _ sipc  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops dip dsn dsk oip osn sip.
           msg_zhops (Rreq hops dip dsn dsk oip osn sip) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq  _ _ _ _ _ osnc _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops dip dsn dsk oip osn sip.
           rreq_rrep_sn (Rreq hops dip dsn dsk oip osn sip) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc  _ _ _ oipc osnc ipcc  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops dip dsn dsk oip osn sip.
           rreq_rrep_fresh crt (Rreq hops dip dsn dsk oip osn sip) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops dip dsn dsk oip osn sip.
                           rerr_invalid crt (Rreq hops dip dsn dsk oip osn sip) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory A_Fresher

(*  Title:       variants/a_norreqid/Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Quality relations between routes"

theory A_Fresher
imports A_Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (0, dsk, flag, hops, nhip, pre) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, val, hops, nhip, pre) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, inv, hops, nhip, pre) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (dsn, dsk, flag, hops, nhip, pre)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip pre
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip, pre))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip, pre))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip, pre))"
  using assms by (cases flag) auto

lemma nsqnr_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqnr (the (the (addpreRT rt dip npre) dip')) = nsqnr (the (rt dip'))"
  unfolding addpreRT_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    nsqn (update rt ip (dsn, kno, val, hops, nhip, {})) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqn (the (addpreRT rt dip npre)) dip' = nsqn rt dip'"
  unfolding addpreRT_def nsqn_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip pre rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip, pre)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip pre
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip, pre)"
      unfolding invalidate_def
      by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip' pre pre'
  shows "(dsn, dsk, flag, hops, nhip, pre)  (dsn, dsk', flag, hops, nhip', pre')"
  unfolding fresher_def by (cases flag) simp_all

lemma addpre_fresher [simp]: "r npre. r  (addpre r npre)"
  by clarsimp

subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn pren
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn, pren)"
      by (metis prod_cases6)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn, pren)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip pre
        from hopsn  1 have "pre'. (dsnn, dskn, fn, hopsn, nhipn, pren)
                                         (dsnn, unk, val, Suc 0, nhip, pre')"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (0, unk, val, Suc 0, nhip, pre) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip pre
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (dsn, kno, val, hops, nhip, pre) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]

lemma rt_fresh_as_addpreRT [simp]:
  assumes "ipkD(rt)"
    shows "rtdip the (addpreRT rt ip npre)"
  using assms [THEN kD_Some] by (auto simp: addpreRT_def)

lemmas rt_fresher_addpreRT [simp] = rt_fresh_as_addpreRT [THEN rt_fresh_asD1]

subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma addpreRT_strictly_fresher [simp]:
  assumes "dip  kD(rt)"
    shows "(the (addpreRT rt dip npre)ip rt2) = (rtip rt2)"
  using assms unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "update rt dip (osn, kno, val, hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip, {})"
    shows "update rt dip (osn, kno, val, Suc hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory A_Seq_Invariants

(*  Title:       variants/a_norreqid/Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant proofs on individual processes"

theory A_Seq_Invariants
imports AWN.Invariants A_Aodv A_Aodv_Data A_Aodv_Predicates A_Fresher

begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:1}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms

lemma rrep_1_update_changes:
  "paodv i  onl ΓAODV (λ(ξ, l). (l = PRrep-:1 
                        rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})))"
  by inv_cterms

lemma addpreRT_partly_welldefined:
  "paodv i 
     onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  {PRrep-:2..PRrep-:6}  dip ξ  kD (rt ξ))
                       (l  {PRreq-:3..PRreq-:17}  oip ξ  kD (rt ξ)))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip, {})"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip) = ip
                  the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip)  kD (rt ξ))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                              onl_invariant_sterms [OF aodv_wf addpreRT_partly_welldefined]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.22: needed in Proposition 7.4›

lemma addpreRT_welldefined:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  kD (rt ξ)) 
                               (l = PRreq-:17  oip ξ  kD (rt ξ))                   
                               (l = PRrep-:5   dip ξ  kD (rt ξ)) 
                               (l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD (rt ξ)))"
  (is "_  onl ΓAODV ?P")
  unfolding invariant_def
  proof
    fix s
    assume "s  reachable (paodv i) TT"
    then obtain ξ p where "s = (ξ, p)"
                      and "(ξ, p)  reachable (paodv i) TT"
      by (metis prod.exhaust)
    have "onl ΓAODV ?P (ξ, p)"
    proof (rule onlI)
      fix l
      assume "l  labels ΓAODV p"
      with (ξ, p)  reachable (paodv i) TT›
        have I1: "l  {PRreq-:16..PRreq-:18}  dip ξ  kD(rt ξ)"
         and I2: "l = PRreq-:17  oip ξ  kD(rt ξ)"
         and I3: "l  {PRrep-:2..PRrep-:6}   dip ξ  kD(rt ξ)"
         by (auto dest!: invariantD [OF addpreRT_partly_welldefined])
      moreover from (ξ, p)  reachable (paodv i) TT› l  labels ΓAODV p and I3
        have "l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD(rt ξ)"
          by (auto dest!: invariantD [OF includes_nhip])
      ultimately show "?P (ξ, l)"
        by simp
    qed
    with s = (ξ, p) show "onl ΓAODV ?P s"
      by simp
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                 simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:19}
                                  {PPkt-:7..PPkt-:11}
                                  {PRreq-:9..PRreq-:13}
                                  {PRreq-:21..PRreq-:25}
                                  {PRrep-:10..PRrep-:14}
                                  {PRerr-:1..PRerr-:5}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:5, PRreq-:6}  dip ξ = ip ξ)
                             (l  {PRreq-:15..PRreq-:18}  dip ξ  ip ξ))"
  proof (inv_cterms, elim conjE)
    fix l ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:17}λξ. ξrt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}) p'
               sterms ΓAODV pp"
       and "l = PRreq-:17"
       and "dip ξ  vD (rt ξ)"
    from this(1-3) have "oip ξ  kD (rt ξ)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRreq-:17"])
    with ‹dip ξ  vD (rt ξ)
      show "dip ξ  vD (the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}))" by simp
  qed

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:18}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:18"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip, {})) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip, {})) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                            onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:16..PRreq-:18}  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3, PRreq-:4, PRreq-:15, PRreq-:27}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {}) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:2..PRrep-:7}  (dip ξ  kD(rt ξ)
                                         sqn (rt ξ) (dip ξ) = dsn ξ
                                         the (dhops (rt ξ) (dip ξ)) = Suc (hops ξ)
                                         the (flag (rt ξ) (dip ξ)) = val
                                         the (nhop (rt ξ) (dip ξ))  kD (rt ξ))))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rrep_1_update_changes]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD])

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9,
                                            PRreq-:21, PRrep-:10, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:19}
                               {PPkt-:8..PPkt-:11}
                               {PRreq-:10..PRreq-:13}
                               {PRreq-:22..PRreq-:25}
                               {PRrep-:11..PRrep-:14}
                               {PRerr-:2..PRerr-:5}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:14  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9, PRreq-:21, PRrep-:10}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf addpreRT_welldefined [THEN invariant_restrict_inD]])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:1}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory A_Quality_Increases

(*  Title:       variants/a_norreqid/Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The quality increases predicate"

theory A_Quality_Increases
imports A_Aodv_Predicates A_Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc  _ _ _ oipc osnc sipc  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops dip dsn dsk oip osn sip.
           msg_fresh σ (Rreq hops dip dsn dsk oip osn sip) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn dsk oip osn sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops dip dsn dsk oip osn sip)"
      and "rreq_rrep_sn (Rreq hops  dip dsn dsk oip osn sip)"
  shows "msg_fresh σ (Rreq hops  dip dsn dsk oip osn sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops rreqid dip dsn dsk oip osn sip
    assume [simp]: "m = Rreq hops  dip dsn dsk oip osn sip"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory A_OAodv

(*  Title:       variants/a_norreqid/OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory A_OAodv
imports A_Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory A_Global_Invariants

(*  Title:       variants/a_norreqid/Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Global invariant proofs over sequential processes"

theory A_Global_Invariants
imports A_Seq_Invariants
        A_Aodv_Predicates
        A_Fresher
        A_Quality_Increases
        AWN.OAWN_Convert
        A_OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed

text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas oaddpreRT_welldefined =
         open_seq_invariant [OF addpreRT_welldefined initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i), {}))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i), {}))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by (clarsimp elim!: kD_quality_increases)
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip, {})) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip, {})) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}) = rt (σ i)"

          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_compare_next_hop:
  fixes w
  shows "opaodv i  (otherwith ((=)) {i} (orecvmsg msg_fresh),
                      other quality_increases {i} →)
                       global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                         in dip  kD(rt (σ i))  nhip  dip 
                                            dip  kD(rt (σ nhip))
                                             nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  by (rule oinvariant_weakenE [OF seq_compare_next_hop']) (auto dest!: onlD)

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory A_Loop_Freedom

(*  Title:       variants/a_norreqid/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Routing graphs and loop freedom"

theory A_Loop_Freedom
imports A_Aodv_Predicates A_Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops pre.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip', pre)})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops pre. r dip = Some (dsn, dsk, val, hops, ip', pre)))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory A_Aodv_Loop_Freedom

(*  Title:       variants/a_norreqid/Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory A_Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting A_Global_Invariants A_Loop_Freedom
begin

text ‹lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory B_Fwdrreps

(*  Title:       variants/b_fwdrreps/B_Fwdrreps.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible B_Fwdrreps
imports "../../Aodv_Basic"
begin

chapter "Variant B: Forwarding the Route Reply"

text ‹
  Explanation~\cite[\textsection 10.2]{FehnkerEtAl:AWN:2013}:
  In AODV's route discovery process, a RREP message from the destination 
  node is unicast back along a route towards the originator of the RREQ 
  message. Every intermediate node on the selected route will process the 
  RREP message and, in most cases, forward it towards the originator node. 
  However, there is a possibility that the RREP message is discarded at an 
  intermediate node, which results in the originator node not receiving a 
  reply. The discarding of the RREP message is due to the RFC specification 
  of AODV~\cite{RFC3561} stating that an intermediate node only forwards the 
  RREP message if it is not the originator node and it has created or 
  updated a routing table entry to the destination node described in the 
  RREP message. The latter requirement means that if a valid routing table 
  entry to the destination node already exists, and is not updated when 
  processing the RREP message, then the intermediate node will not forward 
  the message. A solution to this problem is to require intermediate nodes 
  to forward all RREP messages that they receive.
›

end %invisible

Theory B_Aodv_Data

(*  Title:       variants/b_fwdrreps/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Predicates and functions used in the AODV model"

theory B_Aodv_Data
imports B_Fwdrreps
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a 6-tuple, @{term "(dsn, dsk, flag, hops, nhip, pre)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, @{term nhip} is the
  next hop toward the destination, and @{term pre} is the set of `precursor nodes'--those
  interested in hearing about changes to the route.
›

type_synonym r = "sqn × k × f × nat × ip × ip set"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip, _). nhip"

definition proj7 :: "r  ip set" ("π7")
  where "π7  λ(_, _, _, _, _, pre). pre"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip, pre) = dsn"
  "π3(dsn, dsk, flag, hops, nhip, pre) = dsk"
  "π4(dsn, dsk, flag, hops, nhip, pre) = flag"
  "π5(dsn, dsk, flag, hops, nhip, pre) = hops"
  "π6(dsn, dsk, flag, hops, nhip, pre) = nhip"
  "π7(dsn, dsk, flag, hops, nhip, pre) = pre"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def proj7_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

abbreviation precs :: "rt  ip  ip set"
   where "precs rt dip  map_option π7 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip, pre)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip, pre)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip, pre)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop pre
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop, pre)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating Precursor Lists"

definition addpre :: "r  ip set  r"
  where "addpre r npre  let (dsn, dsk, flag, hops, nhip, pre) = r in
                          (dsn, dsk, flag, hops, nhip, pre  npre)"

lemma proj2_addpre:
  fixes v pre
  shows "π2(addpre v pre) = π2(v)"
  unfolding addpre_def by (cases v) simp

lemma proj3_addpre:
  fixes v pre
  shows "π3(addpre v pre) = π3(v)"
  unfolding addpre_def by (cases v) simp

lemma proj4_addpre:
  fixes v pre
  shows "π4(addpre v pre) = π4(v)"
  unfolding addpre_def by (cases v) simp

lemma proj5_addpre:
  fixes v pre
  shows "π5(addpre v pre) = π5(v)"
  unfolding addpre_def by (cases v) simp

lemma proj6_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π6(addpre v npre) = π6(v)"
  unfolding addpre_def by (cases v) simp

lemma proj7_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π7(addpre v npre) = π7(v)  npre"
  unfolding addpre_def by (cases v) simp

lemma addpre_empty: "addpre r {} = r"
  unfolding addpre_def by simp

lemma addpre_r:
  "addpre (dsn, dsk, fl, hops, nhip, pre) npre = (dsn, dsk, fl, hops, nhip, pre  npre)"
  unfolding addpre_def by simp

lemmas addpre_simps [simp] = proj2_addpre proj3_addpre proj4_addpre proj5_addpre
                             proj6_addpre proj7_addpre addpre_empty addpre_r

definition addpreRT :: "rt  ip  ip set  rt"
  where "addpreRT rt dip npre 
           map_option (λs. rt (dip  addpre s npre)) (σroute(rt, dip))"

lemma snd_addpre [simp]:
  "dsn dsn' v pre. (dsn, snd(addpre (dsn', v) pre)) = addpre (dsn, v) pre"
  unfolding addpre_def by clarsimp

lemma proj2_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π2(the (the (addpreRT rt ip' npre) ip)) = π2(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj3_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π3(the (the (addpreRT rt ip' npre) ip)) = π3(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj5_addpreRT [simp]:
  "rt dip ip npre. dipkD(rt)  π5(the (the (addpreRT rt dip npre) ip)) = π5(the (rt ip))"
  unfolding addpreRT_def by auto

lemma flag_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "flag (the (addpreRT rt dip pre)) ip = flag rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

  lemma kD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "kD (the (addpreRT rt dip npre)) = kD rt"
  unfolding kD_def addpreRT_def
  using assms [THEN kD_Some]
  by clarsimp blast

lemma vD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "vD (the (addpreRT rt dip npre)) = vD rt"
  unfolding vD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma iD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "iD (the (addpreRT rt dip npre)) = iD rt"
  unfolding iD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma nhop_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "nhop (the (addpreRT rt dip pre)) ip = nhop rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqn_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "sqn (the (addpreRT rt dip pre)) ip = sqn rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma dhops_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "dhops (the (addpreRT rt dip pre)) ip = dhops rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqnf_addpreRT [simp]:
  "ip dip. ipkD(rt ξ)  sqnf (the (addpreRT (rt ξ) ip npre)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def addpreRT_def by auto

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip pre
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip pre. update_arg_wf (0, unk, val, Suc 0, nhip, pre)"
  "n hops nhip pre. update_arg_wf (Suc n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip pre. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip pre. P (0, unk, val, Suc 0, nhip, pre)"
      and c2: "dsn hops nhip pre. dsn > 0  P (dsn, kno, val, hops, nhip, pre)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip pre
    where *: "r = (dsn, dsk, flag, hops, nhip, pre)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip, pre)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  addpre r (π7(s)))
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  addpre r (π7(s)))
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (addpre r (π7(s)))))
                    else rt (ip  addpre s (π7(r)))"

lemma update_simps [simp]:
  fixes r s nrt nr nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr  addpre r (π7(s))"
      and "nr'  (π2(s), π3(nr), π4(nr), π5(nr), π6(nr), π7(nr))"
      and "ns  addpre s (π7(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  nr)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  ns)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  nr)"
      unfolding update_def nr_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def nr_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  ns)"
      unfolding update_def ns_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r), π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip pre
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip' pre'
      where req: "r = (dsn', dsk', fl', hops', nhip', pre')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r),
                                            π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  addpre r (π7(the (rt ip)))))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r),
                        π7(addpre r (π7(the (rt ip)))))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  addpre (the (rt ip)) (π7(r))))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip, pre)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip, {})"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip, {})) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip, {})
              rt(dip  addpre (the (rt dip)) (π7 (dsn, dsk, flag, hops, nhip, {})))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip pre
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip, pre)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip, pre) = 0) = (π3 (dsn, dsk, val, hops, nhip, pre) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip pre
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip, pre)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip pre
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip, pre)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip pre. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip, {})) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops npre.
   the (nhop (update rt dip (dsn, unk, val, hops, ip, npre)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip, {})  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip, {}))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip, {})  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip, {})
          ¬P (update rt ip (dsn, dsk, flag, hops, sip, {}))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   sqn (update rt dip (dsn, kno, flg, hops, sip, {})) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   sqnf (update rt dip (dsn, dsk, flg, hops, sip, {})) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops npre. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip, npre)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   π3(the (update rt dip (dsn, dsk, flg, hops, sip, {}) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    the (nhop (update rt ip (dsn, kno, val, hops, nhip, {})) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   the (flag (update rt dip (dsn, kno, flg, hops, sip, {})) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip pre
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip, pre)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip, pre))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip pre.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip, pre))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip, pre), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip, pre)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj7_invalidate [simp]:
  "dip. π7(the ((invalidate rt dests) dip)) = π7(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip, pre)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))
            pre = π7(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto


lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Route Requests"

text ‹Generate a fresh route request identifier.›

definition nrreqid :: "(ip × rreqid) set  ip  rreqid"
  where "nrreqid rreqs ip  Max ({n. (ip, n)  rreqs}  {0}) + 1"

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory B_Aodv_Message

(*  Title:       variants/b_fwdrreps/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "AODV protocol messages"

theory B_Aodv_Message
imports B_Fwdrreps
begin

datatype msg =
    Rreq nat rreqid ip sqn k ip sqn ip
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × rreqid × ip × sqn × k × ip × sqn × ip  msg"
  where "rreq  λ(hops, rreqid, dip, dsn, dsk, oip, osn, sip).
                    Rreq hops rreqid dip dsn dsk oip osn sip"

lemma rreq_simp [simp]:
  "rreq(hops, rreqid, dip, dsn, dsk, oip, osn, sip) =  Rreq hops rreqid dip dsn dsk oip osn sip"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops rreqid dip dsn dsk oip osn sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory B_Aodv

(*  Title:       variants/b_fwdrreps/Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The AODV protocol"

theory B_Aodv
imports B_Aodv_Data B_Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × rreqid) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"
  pre    :: "ip set"
  rreqid :: "rreqid"
  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),
         pre    = (SOME x. True),
         rreqid = (SOME x. True),
         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),
    pre    := (SOME x. True),
    rreqid := (SOME x. True),
    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
                       { ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' rreqid' dip' dsn' dsk' oip' osn' sip'.
               msg ξ = Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
               ξ' = ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, rreqid, dip, dsn, dsk, oip, osn, sip) = args ξ in
         (clear_locals ξ)  hops := hops, rreqid := rreqid, dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREQ(λξ. (hops ξ, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqid := nrreqid (rreqs ξ) (ip ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, rreqid ξ)} 
         broadcast(λξ. rreq(0, rreqid ξ, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ),
                            ip ξ, sn ξ, ip ξ)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
           ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                   then (dests ξ) rip else None) 
           groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             groupcast(λξ. the (precs (rt ξ) (dip ξ)),
                       λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)], ip ξ)). AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, rreqid ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, rreqid ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, rreqid ξ)} 
       (
         ξ. dip ξ = ip ξ
           ξ. ξ  sn := max (sn ξ) (dsn ξ) 
           unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
          ξ. dip ξ  ip ξ
         (
           ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {sip ξ}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                         sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
             broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                dsk ξ, oip ξ, osn ξ, ip ξ)).
             AODV()
         )
       ))"

| "ΓAODV PRrep = labelled PRrep (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)  dip ξ  vD (rt ξ)
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ)
                                               {the (nhop (rt ξ) (oip ξ))})  
             ξ. ξ  rt := the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ))) {the (nhop (rt ξ) (oip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                                                             sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)   dip ξ  vD (rt ξ)
             AODV()
         )
       )
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
     ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                             then (dests ξ) rip else None) 
     groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV())"

declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory B_Aodv_Predicates

(*  Title:       variants/b_fwdrreps/Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant assumptions and properties"

theory B_Aodv_Predicates
imports B_Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ _ ipc  ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                          msg_sender (Rreq hops rreqid dip dsn dsk oip osn sip) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc _ dipc _ _ oipc _ sipc  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_zhops (Rreq hops rreqid dip dsn dsk oip osn sip) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq _ _ _ _ _ _ osnc _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc _ _ _ _ oipc osnc ipcc  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_fresh crt (Rreq hops rreqid dip dsn dsk oip osn sip) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                           rerr_invalid crt (Rreq hops rreqid dip dsn dsk oip osn sip) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory B_Fresher

(*  Title:       variants/b_fwdrreps/Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Quality relations between routes"

theory B_Fresher
imports B_Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (0, dsk, flag, hops, nhip, pre) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, val, hops, nhip, pre) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, inv, hops, nhip, pre) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (dsn, dsk, flag, hops, nhip, pre)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip pre
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip, pre))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip, pre))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip, pre))"
  using assms by (cases flag) auto

lemma nsqnr_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqnr (the (the (addpreRT rt dip npre) dip')) = nsqnr (the (rt dip'))"
  unfolding addpreRT_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    nsqn (update rt ip (dsn, kno, val, hops, nhip, {})) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqn (the (addpreRT rt dip npre)) dip' = nsqn rt dip'"
  unfolding addpreRT_def nsqn_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip pre rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip, pre)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip pre
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip, pre)"
      unfolding invalidate_def
      by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip' pre pre'
  shows "(dsn, dsk, flag, hops, nhip, pre)  (dsn, dsk', flag, hops, nhip', pre')"
  unfolding fresher_def by (cases flag) simp_all

lemma addpre_fresher [simp]: "r npre. r  (addpre r npre)"
  by clarsimp

subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn pren
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn, pren)"
      by (metis prod_cases6)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn, pren)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip pre
        from hopsn  1 have "pre'. (dsnn, dskn, fn, hopsn, nhipn, pren)
                                         (dsnn, unk, val, Suc 0, nhip, pre')"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (0, unk, val, Suc 0, nhip, pre) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip pre
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (dsn, kno, val, hops, nhip, pre) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]

lemma rt_fresh_as_addpreRT [simp]:
  assumes "ipkD(rt)"
    shows "rtdip the (addpreRT rt ip npre)"
  using assms [THEN kD_Some] by (auto simp: addpreRT_def)

lemmas rt_fresher_addpreRT [simp] = rt_fresh_as_addpreRT [THEN rt_fresh_asD1]

subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma addpreRT_strictly_fresher [simp]:
  assumes "dip  kD(rt)"
    shows "(the (addpreRT rt dip npre)ip rt2) = (rtip rt2)"
  using assms unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "update rt dip (osn, kno, val, hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip, {})"
    shows "update rt dip (osn, kno, val, Suc hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory B_Seq_Invariants

(*  Title:       variants/b_fwdrreps/Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant proofs on individual processes"

theory B_Seq_Invariants
imports AWN.Invariants B_Aodv B_Aodv_Data B_Aodv_Predicates B_Fresher

begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:4}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms


lemma addpreRT_partly_welldefined:
  "paodv i 
     onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  {PRrep-:1..PRrep-:5}  dip ξ  kD (rt ξ))
                       (l  {PRreq-:3..PRreq-:17}  oip ξ  kD (rt ξ)))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip, {})"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip) = ip
                  the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip)  kD (rt ξ))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                              onl_invariant_sterms [OF aodv_wf addpreRT_partly_welldefined]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.22: needed in Proposition 7.4›

lemma addpreRT_welldefined:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  kD (rt ξ)) 
                               (l = PRreq-:17  oip ξ  kD (rt ξ))                   
                               (l = PRrep-:4   dip ξ  kD (rt ξ)) 
                               (l = PRrep-:5   (the (nhop (rt ξ) (dip ξ)))  kD (rt ξ)))"
  (is "_  onl ΓAODV ?P")
  unfolding invariant_def
  proof
    fix s
    assume "s  reachable (paodv i) TT"
    then obtain ξ p where "s = (ξ, p)"
                      and "(ξ, p)  reachable (paodv i) TT"
      by (metis prod.exhaust)
    have "onl ΓAODV ?P (ξ, p)"
    proof (rule onlI)
      fix l
      assume "l  labels ΓAODV p"
      with (ξ, p)  reachable (paodv i) TT›
        have I1: "l  {PRreq-:16..PRreq-:18}  dip ξ  kD(rt ξ)"
         and I2: "l = PRreq-:17  oip ξ  kD(rt ξ)"
         and I3: "l  {PRrep-:1..PRrep-:5}   dip ξ  kD(rt ξ)"
         by (auto dest!: invariantD [OF addpreRT_partly_welldefined])
      moreover from (ξ, p)  reachable (paodv i) TT› l  labels ΓAODV p and I3
        have "l = PRrep-:5   (the (nhop (rt ξ) (dip ξ)))  kD(rt ξ)"
          by (auto dest!: invariantD [OF includes_nhip])
      ultimately show "?P (ξ, l)"
        by simp
    qed
    with s = (ξ, p) show "onl ΓAODV ?P s"
      by simp
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                 simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:19}
                                  {PPkt-:7..PPkt-:11}
                                  {PRreq-:9..PRreq-:13}
                                  {PRreq-:21..PRreq-:25}
                                  {PRrep-:9..PRrep-:13}
                                  {PRerr-:1..PRerr-:5}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:18}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:5, PRreq-:6}  dip ξ = ip ξ)
                             (l  {PRreq-:15..PRreq-:18}  dip ξ  ip ξ))"
  proof (inv_cterms, elim conjE)
    fix l ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:17}λξ. ξrt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}) p'
               sterms ΓAODV pp"
       and "l = PRreq-:17"
       and "dip ξ  vD (rt ξ)"
    from this(1-3) have "oip ξ  kD (rt ξ)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRreq-:17"])
    with ‹dip ξ  vD (rt ξ)
      show "dip ξ  vD (the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}))" by simp
  qed

lemma rrep_dip_in_vD:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRrep-:4..PRrep-:6}  dip ξ  vD(rt ξ)))"
  proof inv_cterms
    fix l ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) TT"
      and " {PRrep-:5}λξ. ξrt := the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ))) {the (nhop (rt ξ) (oip ξ))}) p'
               sterms ΓAODV pp"
      and "l = PRrep-:5"
      and "dip ξ  vD (rt ξ)"
    from this(1-3) have "the (nhop (rt ξ) (dip ξ))  kD (rt ξ)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRrep-:5"])
    with ‹dip ξ  vD (rt ξ)
      show "dip ξ  vD (the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ))) {the (nhop (rt ξ) (oip ξ))}))" by simp
  qed

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
           onl_invariant_sterms [OF aodv_wf rrep_dip_in_vD]
           onl_invariant_sterms [OF aodv_wf hop_count_positive],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:18}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:18"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  next
    fix l ξ a pp p' pp'    
    assume "(ξ, pp)  reachable (paodv i) TT"
      and "{PRrep-:6}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
              λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp" 
      and "l = PRrep-:6"
      and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
      and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
      and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "the (dhops (rt ξ) (dip ξ)) = 0  dip ξ = ip ξ"
      by auto
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip, {})) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip, {})) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                            onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:16..PRreq-:18}  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined])

    have rrep_sqn_greater_dsn: "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                      (l  {PRrep-:1 .. PRrep-:6}  1  sqn (rt ξ) (dip ξ)))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                              onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (clarsimp simp: update_kno_dsn_greater_zero [simplified])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                              onl_invariant_sterms [OF aodv_wf rrep_sqn_greater_dsn])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3, PRreq-:4, PRreq-:15, PRreq-:27}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {}) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:4..PRrep-:6}  (dip ξ  kD(rt ξ)
                                         the (flag (rt ξ) (dip ξ)) = val)))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD]) 
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9,
                                            PRreq-:21, PRrep-:9, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:19}
                               {PPkt-:8..PPkt-:11}
                               {PRreq-:10..PRreq-:13}
                               {PRreq-:22..PRreq-:25}
                               {PRrep-:10..PRrep-:13}
                               {PRerr-:2..PRerr-:5}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:14  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9, PRreq-:21, PRrep-:9}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf addpreRT_welldefined [THEN invariant_restrict_inD]])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:0}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory B_Quality_Increases

(*  Title:       variants/b_fwdrreps/Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The quality increases predicate"

theory B_Quality_Increases
imports B_Aodv_Predicates B_Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc _ _ _ _ oipc osnc sipc  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops rreqid dip dsn dsk oip osn sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops rreqid dip dsn dsk oip osn sip)"
      and "rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip)"
  shows "msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops rreqid dip dsn dsk oip osn sip
    assume [simp]: "m = Rreq hops rreqid dip dsn dsk oip osn sip"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory B_OAodv

(*  Title:       variants/b_fwdrreps/OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory B_OAodv
imports B_Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory B_Global_Invariants

(*  Title:       variants/b_fwdrreps/Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Global invariant proofs over sequential processes"

theory B_Global_Invariants
imports B_Seq_Invariants
        B_Aodv_Predicates
        B_Fresher
        B_Quality_Increases
        AWN.OAWN_Convert
        B_OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed

text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas oaddpreRT_welldefined =
         open_seq_invariant [OF addpreRT_welldefined initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i), {}))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i), {}))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by (clarsimp elim!: kD_quality_increases)
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip, {})) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip, {})) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}) = rt (σ i)"

          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_compare_next_hop:
  fixes w
  shows "opaodv i  (otherwith ((=)) {i} (orecvmsg msg_fresh),
                      other quality_increases {i} →)
                       global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                         in dip  kD(rt (σ i))  nhip  dip 
                                            dip  kD(rt (σ nhip))
                                             nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  by (rule oinvariant_weakenE [OF seq_compare_next_hop']) (auto dest!: onlD)

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory B_Loop_Freedom

(*  Title:       variants/b_fwdrreps/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Routing graphs and loop freedom"

theory B_Loop_Freedom
imports B_Aodv_Predicates B_Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops pre.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip', pre)})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops pre. r dip = Some (dsn, dsk, val, hops, ip', pre)))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory B_Aodv_Loop_Freedom

(*  Title:       variants/b_fwdrreps/Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory B_Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting B_Global_Invariants B_Loop_Freedom
begin

subsection ‹Lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory C_Gtobcast

(*  Title:       variants/c_gtobcast/C_Gtobcast.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible C_Gtobcast
imports "../../Aodv_Basic"
begin

chapter "Variant C: From Groupcast to Broadcast"

text ‹
  Explanation~\cite[\textsection 10.4]{FehnkerEtAl:AWN:2013}:
  A node maintains a set of `precursor nodes' for each of its valid routes.
  If the link to a route's next hop is lost, an error message is groupcast 
  to the associated precursor nodes. The idea is to reduce the number of
  messages received and handled. However, precursor lists are incomplete. 
  They are updated only when a RREP message is sent. This can lead to packet 
  loss. A possible solution is to abandon precursors and to replace every 
  groupcast by a broadcast. At first glance this strategy seems to need more 
  bandwidth, but this is not the case. Sending error messages to a set of 
  precursors is implemented at the link layer by broadcasting the message 
  anyway; a node receiving such a message then checks the header to 
  determine whether it is one of the intended recipients. Instead of 
  analysing the header only, a node can just as well read the message and 
  decide whether the information contained in the message is of use. To be 
  more precise: an error message is useful for a node if the node has 
  established a route to one of the nodes listed in the message, and the 
  next hop to a listed node is the sender of the error message. In case a 
  node finds useful information inside the message, it should update its 
  routing table and distribute another error message.
›

end %invisible

Theory C_Aodv_Data

(*  Title:       variants/c_gtobcast/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Predicates and functions used in the AODV model"

theory C_Aodv_Data
imports C_Gtobcast
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a 5-tuple, @{term "(dsn, dsk, flag, hops, nhip)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, and @{term nhip} is the
  next hop toward the destination.
  In this variant, the set of `precursor nodes' is not modelled.
›

type_synonym r = "sqn × k × f × nat × ip"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip). nhip"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip) = dsn"
  "π3(dsn, dsk, flag, hops, nhip) = dsk"
  "π4(dsn, dsk, flag, hops, nhip) = flag"
  "π5(dsn, dsk, flag, hops, nhip) = hops"
  "π6(dsn, dsk, flag, hops, nhip) = nhip"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip. update_arg_wf (0, unk, val, Suc 0, nhip)"
  "n hops nhip. update_arg_wf (Suc n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip. P (0, unk, val, Suc 0, nhip)"
      and c2: "dsn hops nhip. dsn > 0  P (dsn, kno, val, hops, nhip)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip
    where *: "r = (dsn, dsk, flag, hops, nhip)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  r)
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  r)
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (r)))
                    else rt (ip  s)"

lemma update_simps [simp]:
  fixes r s nrt nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr'  (π2(s), π3(r), π4(r), π5(r), π6(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  r)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  s)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  r)"
      unfolding update_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  r)"
        unfolding update_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  r)"
        unfolding update_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  s)"
      unfolding update_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  r ))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  r ))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  r ))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  the σroute(rt, ip)))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip'
      where req: "r = (dsn', dsk', fl', hops', nhip')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  r ))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  r ))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  r ))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  the σroute(rt, ip)))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  r))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  r))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  r))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  the (rt ip)))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip)"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip)) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip)
              rt(dip  the (rt dip))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip) = 0) = (π3 (dsn, dsk, val, hops, nhip) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip)"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip)) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops.
   the (nhop (update rt dip (dsn, unk, val, hops, ip)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip)  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip)  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip)
          ¬P (update rt ip (dsn, dsk, flag, hops, sip))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip)
   sqn (update rt dip (dsn, kno, flg, hops, sip)) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   sqnf (update rt dip (dsn, dsk, flg, hops, sip)) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   π3(the (update rt dip (dsn, dsk, flg, hops, sip) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip)
    the (nhop (update rt ip (dsn, kno, val, hops, nhip)) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip)
   the (flag (update rt dip (dsn, kno, flg, hops, sip)) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)


lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto


lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Route Requests"

text ‹Generate a fresh route request identifier.›

definition nrreqid :: "(ip × rreqid) set  ip  rreqid"
  where "nrreqid rreqs ip  Max ({n. (ip, n)  rreqs}  {0}) + 1"

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory C_Aodv_Message

(*  Title:       variants/c_gtobcast/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "AODV protocol messages"

theory C_Aodv_Message
imports C_Gtobcast
begin

datatype msg =
    Rreq nat rreqid ip sqn k ip sqn ip
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × rreqid × ip × sqn × k × ip × sqn × ip  msg"
  where "rreq  λ(hops, rreqid, dip, dsn, dsk, oip, osn, sip).
                    Rreq hops rreqid dip dsn dsk oip osn sip"

lemma rreq_simp [simp]:
  "rreq(hops, rreqid, dip, dsn, dsk, oip, osn, sip) =  Rreq hops rreqid dip dsn dsk oip osn sip"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops rreqid dip dsn dsk oip osn sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory C_Aodv

(*  Title:       variants/c_gtobcast/Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The AODV protocol"

theory C_Aodv
imports C_Aodv_Data C_Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × rreqid) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"
  rreqid :: "rreqid"
  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),
         rreqid = (SOME x. True),
         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),
    rreqid := (SOME x. True),
    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
                       { ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' rreqid' dip' dsn' dsk' oip' osn' sip'.
               msg ξ = Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' 
               ξ' = ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, rreqid, dip, dsn, dsk, oip, osn, sip) = args ξ in
         (clear_locals ξ)  hops := hops, rreqid := rreqid, dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RREQ(λξ. (hops ξ, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqid := nrreqid (rreqs ξ) (ip ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, rreqid ξ)} 
         broadcast(λξ. rreq(0, rreqid ξ, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ), ip ξ, sn ξ,
                            ip ξ)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             broadcast(λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)], ip ξ)). AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, rreqid ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, rreqid ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, rreqid ξ)} 
       (
         ξ. dip ξ = ip ξ
           ξ. ξ  sn := max (sn ξ) (dsn ξ) 
           unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
          ξ. dip ξ  ip ξ
         (
           ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                                                             sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
             broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                dsk ξ, oip ξ, osn ξ, ip ξ)).
             AODV()
         )
       ))"

| "ΓAODV PRrep = labelled PRrep (
     ξ. rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ) 
     (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ)  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(hops ξ + 1, dip ξ,
                         dsn ξ, oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)
             AODV()
         )
       )
     )
      ξ. rt ξ = update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ) 
         AODV()
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     (
        ξ. dests ξ  Map.empty
          broadcast(λξ. rerr(dests ξ, ip ξ)). AODV()
         ξ. dests ξ = Map.empty 
          AODV()
     ))"



declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory C_Aodv_Predicates

(*  Title:       variants/c_gtobcast/Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant assumptions and properties"

theory C_Aodv_Predicates
imports C_Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ _ ipc  ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                          msg_sender (Rreq hops rreqid dip dsn dsk oip osn sip) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc _ dipc _ _ oipc _ sipc  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_zhops (Rreq hops rreqid dip dsn dsk oip osn sip) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq _ _ _ _ _ _ osnc _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc _ _ _ _ oipc osnc ipcc  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           rreq_rrep_fresh crt (Rreq hops rreqid dip dsn dsk oip osn sip) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
                           rerr_invalid crt (Rreq hops rreqid dip dsn dsk oip osn sip) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory C_Fresher

(*  Title:       variants/c_gtobcast/Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria                     
    Author:      Peter Höfner, NICTA
*)

section "Quality relations between routes"

theory C_Fresher
imports C_Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip. nsqnr (0, dsk, flag, hops, nhip) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip. nsqnr (dsn, dsk, val, hops, nhip) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip. nsqnr (dsn, dsk, inv, hops, nhip) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip. nsqnr (dsn, dsk, flag, hops, nhip)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip))"
  using assms by (cases flag) auto

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip)
    nsqn (update rt ip (dsn, kno, val, hops, nhip)) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip pre
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip)"
      unfolding invalidate_def
      by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip'
  shows "(dsn, dsk, flag, hops, nhip)  (dsn, dsk', flag, hops, nhip')"
  unfolding fresher_def by (cases flag) simp_all


subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn)"
      by (metis prod_cases5)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip pre
        from hopsn  1 have "pre'. (dsnn, dskn, fn, hopsn, nhipn)
                                         (dsnn, unk, val, Suc 0, nhip)"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn)
                the (update rt dip (0, unk, val, Suc 0, nhip) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip pre
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn)
                the (update rt dip (dsn, kno, val, hops, nhip) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]


subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip)"
    shows "update rt dip (osn, kno, val, hops, nhip)dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip)) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip)"
    shows "update rt dip (osn, kno, val, Suc hops, nhip)dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip)) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip)) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip)) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory C_Seq_Invariants

(*  Title:       aodvmech/aodv/Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant proofs on individual processes"

theory C_Seq_Invariants
imports AWN.Invariants C_Aodv C_Aodv_Data C_Aodv_Predicates C_Fresher
begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:1}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms

lemma rrep_1_update_changes:
  "paodv i  onl ΓAODV (λ(ξ, l). (l = PRrep-:1 
                        rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ)))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip)"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip)) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip)) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip)"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) ip) = ip
                the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) dip)  kD (rt ξ))"
        by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:17}
                                  {PPkt-:7..PPkt-:9}
                                  {PRreq-:9..PRreq-:11}
                                  {PRreq-:17..PRreq-:19}
                                  {PRrep-:8..PRrep-:10}
                                  {PRerr-:1..PRerr-:4}  {PRerr-:6}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:14}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:5, PRreq-:6}  dip ξ = ip ξ)
                             (l  {PRreq-:13..PRreq-:14}  dip ξ  ip ξ))"
  by inv_cterms

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:14}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:14"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip)) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip)) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip)) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip)) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip)) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip)) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip)) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this
  
    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    (* due to lack of addpreRT_welldefined, sqnf_know needed some small adaption [adding dip ξ ∈ kD (rt ξ)] *)
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:14}  dip ξ  kD (rt ξ)  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms)
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3, PRreq-:4, PRreq-:13, PRreq-:21}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:2..PRrep-:5}  (dip ξ  kD(rt ξ)
                                         sqn (rt ξ) (dip ξ) = dsn ξ
                                         the (dhops (rt ξ) (dip ξ)) = Suc (hops ξ)
                                         the (flag (rt ξ) (dip ξ)) = val
                                         the (nhop (rt ξ) (dip ξ))  kD (rt ξ))))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rrep_1_update_changes]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD])

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9,
                                            PRreq-:17, PRrep-:8, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:17}
                               {PPkt-:8..PPkt-:9}
                               {PRreq-:10..PRreq-:11}
                               {PRreq-:18..PRreq-:19}
                               {PRrep-:9..PRrep-:10}
                               {PRerr-:2..PRerr-:4}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:12  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:9, PRreq-:17, PRrep-:8}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf invariant_restrict_inD])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ)" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:1}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ)" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory C_Quality_Increases

(*  Title:       variants/c_gtobcast/Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The quality increases predicate"

theory C_Quality_Increases
imports C_Aodv_Predicates C_Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc _ _ _ _ oipc osnc sipc  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip.
           msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops rreqid dip dsn dsk oip osn sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops rreqid dip dsn dsk oip osn sip)"
      and "rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip)"
  shows "msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops rreqid dip dsn dsk oip osn sip
    assume [simp]: "m = Rreq hops rreqid dip dsn dsk oip osn sip"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory C_OAodv

(*  Title:       variants/c_gtobcast/OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory C_OAodv
imports C_Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory C_Global_Invariants

(*  Title:       aodvmech/aodv/Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Global invariant proofs over sequential processes"

theory C_Global_Invariants
imports C_Seq_Invariants
        C_Aodv_Predicates
        C_Fresher
        C_Quality_Increases
        AWN.OAWN_Convert
        C_OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed

text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i))) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i)))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i))) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i)))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip)) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip)) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by (clarsimp elim!: kD_quality_increases)
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip)) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip)) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip)) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip)dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip)dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip)) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip)) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip) = rt (σ i)"
  
          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_compare_next_hop:
  fixes w
  shows "opaodv i  (otherwith ((=)) {i} (orecvmsg msg_fresh),
                      other quality_increases {i} →)
                       global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                         in dip  kD(rt (σ i))  nhip  dip 
                                            dip  kD(rt (σ nhip))
                                             nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  by (rule oinvariant_weakenE [OF seq_compare_next_hop']) (auto dest!: onlD)

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory C_Loop_Freedom

(*  Title:       aodvmech/aodv/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Routing graphs and loop freedom"

theory C_Loop_Freedom
imports C_Aodv_Predicates C_Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip')})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops. r dip = Some (dsn, dsk, val, hops, ip')))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory C_Aodv_Loop_Freedom

(*  Title:       aodvmech/aodv/Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory C_Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting C_Global_Invariants C_Loop_Freedom
begin

subsection ‹Lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory D_Fwdrreqs

(*  Title:       variants/d_fwdrreqs/D_Fwdrreqs.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible D_Fwdrreqs
imports "../../Aodv_Basic"
begin

chapter "Variant D: Forwarding the Route Request"

text ‹
  Explanation~\cite[\textsection 10.5]{FehnkerEtAl:AWN:2013}:
  In AODV's route discovery process, a destination node (or an intermediate 
  node with an active route to the destination) will generate a RREP message 
  in response to a received RREQ message. The RREQ message is then dropped 
  and not forwarded. This termination of the route discovery process at the 
  destination can lead to other nodes inadvertently creating non-optimal 
  routes to the source node~\cite{MK10}.
  A possible modification to solve this problem is to allow the destination 
  node to continue to forward the RREQ message. A route request is only 
  stopped if it has been handled before. The forwarded RREQ message from the 
  destination node needs to be modified to include a Boolean flag 
  \verb+handled+ that indicates a RREP message has already been generated 
  and sent in response to the former message. In case the flag is set to 
  true, it prevents other nodes (with valid route to the destination) from 
  sending a RREP message in response to their reception of the forwarded 
  RREQ message.
›

end %invisible

Theory D_Aodv_Data

(*  Title:       variants/d_fwdrreqs/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Predicates and functions used in the AODV model"

theory D_Aodv_Data
imports D_Fwdrreqs
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a 6-tuple, @{term "(dsn, dsk, flag, hops, nhip, pre)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, @{term nhip} is the
  next hop toward the destination, and @{term pre} is the set of `precursor nodes'--those
  interested in hearing about changes to the route.
›

type_synonym r = "sqn × k × f × nat × ip × ip set"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip, _). nhip"

definition proj7 :: "r  ip set" ("π7")
  where "π7  λ(_, _, _, _, _, pre). pre"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip, pre) = dsn"
  "π3(dsn, dsk, flag, hops, nhip, pre) = dsk"
  "π4(dsn, dsk, flag, hops, nhip, pre) = flag"
  "π5(dsn, dsk, flag, hops, nhip, pre) = hops"
  "π6(dsn, dsk, flag, hops, nhip, pre) = nhip"
  "π7(dsn, dsk, flag, hops, nhip, pre) = pre"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def proj7_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

abbreviation precs :: "rt  ip  ip set"
   where "precs rt dip  map_option π7 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip, pre)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip, pre)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip pre.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip, pre)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop pre
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop, pre)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating Precursor Lists"

definition addpre :: "r  ip set  r"
  where "addpre r npre  let (dsn, dsk, flag, hops, nhip, pre) = r in
                          (dsn, dsk, flag, hops, nhip, pre  npre)"

lemma proj2_addpre:
  fixes v pre
  shows "π2(addpre v pre) = π2(v)"
  unfolding addpre_def by (cases v) simp

lemma proj3_addpre:
  fixes v pre
  shows "π3(addpre v pre) = π3(v)"
  unfolding addpre_def by (cases v) simp

lemma proj4_addpre:
  fixes v pre
  shows "π4(addpre v pre) = π4(v)"
  unfolding addpre_def by (cases v) simp

lemma proj5_addpre:
  fixes v pre
  shows "π5(addpre v pre) = π5(v)"
  unfolding addpre_def by (cases v) simp

lemma proj6_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π6(addpre v npre) = π6(v)"
  unfolding addpre_def by (cases v) simp

lemma proj7_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "π7(addpre v npre) = π7(v)  npre"
  unfolding addpre_def by (cases v) simp

lemma addpre_empty: "addpre r {} = r"
  unfolding addpre_def by simp

lemma addpre_r:
  "addpre (dsn, dsk, fl, hops, nhip, pre) npre = (dsn, dsk, fl, hops, nhip, pre  npre)"
  unfolding addpre_def by simp

lemmas addpre_simps [simp] = proj2_addpre proj3_addpre proj4_addpre proj5_addpre
                             proj6_addpre proj7_addpre addpre_empty addpre_r

definition addpreRT :: "rt  ip  ip set  rt"
  where "addpreRT rt dip npre 
           map_option (λs. rt (dip  addpre s npre)) (σroute(rt, dip))"

lemma snd_addpre [simp]:
  "dsn dsn' v pre. (dsn, snd(addpre (dsn', v) pre)) = addpre (dsn, v) pre"
  unfolding addpre_def by clarsimp

lemma proj2_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π2(the (the (addpreRT rt ip' npre) ip)) = π2(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj3_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ipkD rt"
      and "ip'kD rt"
    shows "π3(the (the (addpreRT rt ip' npre) ip)) = π3(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj5_addpreRT [simp]:
  "rt dip ip npre. dipkD(rt)  π5(the (the (addpreRT rt dip npre) ip)) = π5(the (rt ip))"
  unfolding addpreRT_def by auto

lemma flag_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "flag (the (addpreRT rt dip pre)) ip = flag rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

  lemma kD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "kD (the (addpreRT rt dip npre)) = kD rt"
  unfolding kD_def addpreRT_def
  using assms [THEN kD_Some]
  by clarsimp blast

lemma vD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "vD (the (addpreRT rt dip npre)) = vD rt"
  unfolding vD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma iD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip  kD rt"
  shows "iD (the (addpreRT rt dip npre)) = iD rt"
  unfolding iD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma nhop_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "nhop (the (addpreRT rt dip pre)) ip = nhop rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqn_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "sqn (the (addpreRT rt dip pre)) ip = sqn rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma dhops_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip  kD rt"
    shows "dhops (the (addpreRT rt dip pre)) ip = dhops rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqnf_addpreRT [simp]:
  "ip dip. ipkD(rt ξ)  sqnf (the (addpreRT (rt ξ) ip npre)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def addpreRT_def by auto

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip pre
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip pre. update_arg_wf (0, unk, val, Suc 0, nhip, pre)"
  "n hops nhip pre. update_arg_wf (Suc n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip pre. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip pre. P (0, unk, val, Suc 0, nhip, pre)"
      and c2: "dsn hops nhip pre. dsn > 0  P (dsn, kno, val, hops, nhip, pre)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip pre
    where *: "r = (dsn, dsk, flag, hops, nhip, pre)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip, pre)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  addpre r (π7(s)))
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  addpre r (π7(s)))
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (addpre r (π7(s)))))
                    else rt (ip  addpre s (π7(r)))"

lemma update_simps [simp]:
  fixes r s nrt nr nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr  addpre r (π7(s))"
      and "nr'  (π2(s), π3(nr), π4(nr), π5(nr), π6(nr), π7(nr))"
      and "ns  addpre s (π7(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  nr)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  nr)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  ns)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  nr)"
      unfolding update_def nr_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  nr)"
        unfolding update_def nr_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def nr_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  ns)"
      unfolding update_def ns_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r), π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip pre
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip' pre'
      where req: "r = (dsn', dsk', fl', hops', nhip', pre')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  addpre r (π7(the σroute(rt, ip)))))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r),
                                            π7(addpre r (π7(the σroute(rt, ip)))))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  addpre (the σroute(rt, ip)) (π7(r))))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  addpre r (π7(the (rt ip)))))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  addpre r (π7 (the (rt ip)))))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r),
                        π7(addpre r (π7(the (rt ip)))))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  addpre (the (rt ip)) (π7(r))))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip, pre)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip, {})"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip, {})) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip, {})
              rt(dip  addpre (the (rt dip)) (π7 (dsn, dsk, flag, hops, nhip, {})))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip pre
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip, pre)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip, pre) = 0) = (π3 (dsn, dsk, val, hops, nhip, pre) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip pre
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip, pre)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip pre
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip, pre)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip pre. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip, {})) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops npre.
   the (nhop (update rt dip (dsn, unk, val, hops, ip, npre)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip, {})  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip, {}))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip, {})  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip, {})
          ¬P (update rt ip (dsn, dsk, flag, hops, sip, {}))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   sqn (update rt dip (dsn, kno, flg, hops, sip, {})) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   sqnf (update rt dip (dsn, dsk, flg, hops, sip, {})) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops npre. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip, npre)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   π3(the (update rt dip (dsn, dsk, flg, hops, sip, {}) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    the (nhop (update rt ip (dsn, kno, val, hops, nhip, {})) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip, {})
   the (flag (update rt dip (dsn, kno, flg, hops, sip, {})) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip pre
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip, pre)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip, pre))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip, {})
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip pre.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip, pre))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip, pre), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip, pre)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj7_invalidate [simp]:
  "dip. π7(the ((invalidate rt dests) dip)) = π7(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip, pre)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))
            pre = π7(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto


lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Route Requests"

text ‹Generate a fresh route request identifier.›

definition nrreqid :: "(ip × rreqid) set  ip  rreqid"
  where "nrreqid rreqs ip  Max ({n. (ip, n)  rreqs}  {0}) + 1"

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory D_Aodv_Message

(*  Title:       variants/d_fwdrreqs/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "AODV protocol messages"

theory D_Aodv_Message
imports D_Fwdrreqs
begin

datatype msg =
    Rreq nat rreqid ip sqn k ip sqn ip bool
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × rreqid × ip × sqn × k × ip × sqn × ip × bool  msg"
  where "rreq  λ(hops, rreqid, dip, dsn, dsk, oip, osn, sip, handled).
                    Rreq hops rreqid dip dsn dsk oip osn sip handled"

lemma rreq_simp [simp]:
  "rreq(hops, rreqid, dip, dsn, dsk, oip, osn, sip, handled) =  Rreq hops rreqid dip dsn dsk oip osn sip handled"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops rreqid dip dsn dsk oip osn sip handled)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory D_Aodv

(*  Title:       variants/d_fwdrreqs/Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The AODV protocol"

theory D_Aodv
imports D_Aodv_Data D_Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × rreqid) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"
  pre    :: "ip set"
  rreqid :: "rreqid"
  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"
  handled:: "bool"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),
         pre    = (SOME x. True),
         rreqid = (SOME x. True),
         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i),
         handled= (SOME x. True)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),
    pre    := (SOME x. True),
    rreqid := (SOME x. True),
    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ),
    handled:= (SOME x. True)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' handled' 
                       { ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip', 
                            handled := handled'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' rreqid' dip' dsn' dsk' oip' osn' sip' handled'.
               msg ξ = Rreq hops' rreqid' dip' dsn' dsk' oip' osn' sip' handled' 
               ξ' = ξ hops := hops', rreqid := rreqid', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip', 
                       handled := handled' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, rreqid, dip, dsn, dsk, oip, osn, sip, handled) = args ξ in
         (clear_locals ξ)  hops := hops, rreqid := rreqid, dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip, handled := handled 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREQ(λξ. (hops ξ, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ, handled ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ, {}) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqid := nrreqid (rreqs ξ) (ip ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, rreqid ξ)} 
         broadcast(λξ. rreq(0, rreqid ξ, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ), ip ξ, sn ξ,
                            ip ξ, False)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
           ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                   then (dests ξ) rip else None) 
           groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             groupcast(λξ. the (precs (rt ξ) (dip ξ)), λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)],
                                                                ip ξ)).AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, rreqid ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, rreqid ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, rreqid ξ)} 
       (
         ξ. handled ξ = False
         (
           ξ. dip ξ = ip ξ
             ξ. ξ  sn := max (sn ξ) (dsn ξ) 
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).
               broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, ip ξ, True)).
               AODV()
             
               ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                       then Some (inc (sqn (rt ξ) rip)) else None) 
               ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
               ξ. ξ  store := setRRF (store ξ) (dests ξ)
               ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
               ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                       then (dests ξ) rip else None) 
               groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  ip ξ
           (
             ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
               ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {sip ξ}) 
               ξ. ξ  rt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))})  
               unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
               sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
                 broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, dsn ξ,
                                dsk ξ, oip ξ, osn ξ, ip ξ, True)).
                 AODV()
             
               ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                       then Some (inc (sqn (rt ξ) rip)) else None) 
               ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
               ξ. ξ  store := setRRF (store ξ) (dests ξ)
               ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
               ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                       then (dests ξ) rip else None) 
               groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
              ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
               broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                  dsk ξ, oip ξ, osn ξ, ip ξ, False)).
               AODV()
           )
         )
          ξ. handled ξ = True
           broadcast(λξ. rreq(hops ξ + 1, rreqid ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, ip ξ, True)).
           AODV()
       ))"

| "ΓAODV PRrep = labelled PRrep (
     ξ. rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
     (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)
             ξ. ξ  rt := the (addpreRT (rt ξ) (dip ξ) {the (nhop (rt ξ) (oip ξ))}) 
             ξ. ξ  rt := the (addpreRT (rt ξ) (the (nhop (rt ξ) (dip ξ)))
                                               {the (nhop (rt ξ) (oip ξ))})  
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(hops ξ + 1, dip ξ, dsn ξ, oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
             ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                                     then (dests ξ) rip else None) 
             groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)
             AODV()
         )
       )
     )
      ξ. rt ξ = update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {}) 
         AODV()
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     ξ. ξ  pre := { the (precs (rt ξ) rip) | rip. rip  dom (dests ξ) } 
     ξ. ξ  dests := (λrip. if ((dests ξ) rip  None  the (precs (rt ξ) rip)  {})
                             then (dests ξ) rip else None) 
     groupcast(λξ. pre ξ, λξ. rerr(dests ξ, ip ξ)). AODV())"

declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory D_Aodv_Predicates

(*  Title:       variants/d_fwdrreqs/Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant assumptions and properties"

theory D_Aodv_Predicates
imports D_Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ _ ipc _   ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
                          msg_sender (Rreq hops rreqid dip dsn dsk oip osn sip handled) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc _ dipc _ _ oipc _ sipc _  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
           msg_zhops (Rreq hops rreqid dip dsn dsk oip osn sip handled) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq _ _ _ _ _ _ osnc _ _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
           rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip handled) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc _ _ _ _ oipc osnc ipcc _  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
           rreq_rrep_fresh crt (Rreq hops rreqid dip dsn dsk oip osn sip handled) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
                           rerr_invalid crt (Rreq hops rreqid dip dsn dsk oip osn sip handled) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory D_Fresher

(*  Title:       variants/d_fwdrreqs/Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Quality relations between routes"

theory D_Fresher
imports D_Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (0, dsk, flag, hops, nhip, pre) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, val, hops, nhip, pre) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip pre. nsqnr (dsn, dsk, inv, hops, nhip, pre) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip pre. nsqnr (dsn, dsk, flag, hops, nhip, pre)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip pre
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip, pre))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip, pre))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip, pre))"
  using assms by (cases flag) auto

lemma nsqnr_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqnr (the (the (addpreRT rt dip npre) dip')) = nsqnr (the (rt dip'))"
  unfolding addpreRT_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip, {})
    nsqn (update rt ip (dsn, kno, val, hops, nhip, {})) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_addpreRT_inv [simp]:
  "rt dip npre dip'. dip  kD(rt) 
   nsqn (the (addpreRT rt dip npre)) dip' = nsqn rt dip'"
  unfolding addpreRT_def nsqn_def nsqnr_def
  by (frule kD_Some) (clarsimp split: option.split)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip pre rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip, pre)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip pre
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip, pre)"
      unfolding invalidate_def
      by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip' pre pre'
  shows "(dsn, dsk, flag, hops, nhip, pre)  (dsn, dsk', flag, hops, nhip', pre')"
  unfolding fresher_def by (cases flag) simp_all

lemma addpre_fresher [simp]: "r npre. r  (addpre r npre)"
  by clarsimp

subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn pren
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn, pren)"
      by (metis prod_cases6)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn, pren)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip pre
        from hopsn  1 have "pre'. (dsnn, dskn, fn, hopsn, nhipn, pren)
                                         (dsnn, unk, val, Suc 0, nhip, pre')"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (0, unk, val, Suc 0, nhip, pre) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip pre
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn, pren)
                the (update rt dip (dsn, kno, val, hops, nhip, pre) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn, pren)
                    (dsn, kno, val, hops, nhip, pre  pren)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]

lemma rt_fresh_as_addpreRT [simp]:
  assumes "ipkD(rt)"
    shows "rtdip the (addpreRT rt ip npre)"
  using assms [THEN kD_Some] by (auto simp: addpreRT_def)

lemmas rt_fresher_addpreRT [simp] = rt_fresh_as_addpreRT [THEN rt_fresh_asD1]

subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma addpreRT_strictly_fresher [simp]:
  assumes "dip  kD(rt)"
    shows "(the (addpreRT rt dip npre)ip rt2) = (rtip rt2)"
  using assms unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip, {})"
    shows "update rt dip (osn, kno, val, hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip, {}) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip, {})"
    shows "update rt dip (osn, kno, val, Suc hops, nhip, {})dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip, {})) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip, {}) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory D_Seq_Invariants

(*  Title:       variants/d_fwdrreqs/Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant proofs on individual processes"

theory D_Seq_Invariants
imports AWN.Invariants D_Aodv D_Aodv_Data D_Aodv_Predicates D_Fresher
begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:1}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms

lemma rrep_1_update_changes:
  "paodv i  onl ΓAODV (λ(ξ, l). (l = PRrep-:1 
                        rt ξ  update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ, {})))"
  by inv_cterms

lemma addpreRT_partly_welldefined:
  "paodv i 
     onl ΓAODV (λ(ξ, l). (l  {PRreq-:18..PRreq-:20}  {PRrep-:2..PRrep-:6}  dip ξ  kD (rt ξ))
                       (l  {PRreq-:3..PRreq-:19}  oip ξ  kD (rt ξ)))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip, {})"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip, {})) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip) = ip
                  the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip, {})) dip)  kD (rt ξ))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                              onl_invariant_sterms [OF aodv_wf addpreRT_partly_welldefined]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.22: needed in Proposition 7.4›

lemma addpreRT_welldefined:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:18..PRreq-:20}  dip ξ  kD (rt ξ)) 
                               (l = PRreq-:19  oip ξ  kD (rt ξ))                   
                               (l = PRrep-:5   dip ξ  kD (rt ξ)) 
                               (l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD (rt ξ)))"
  (is "_  onl ΓAODV ?P")
  unfolding invariant_def
  proof
    fix s
    assume "s  reachable (paodv i) TT"
    then obtain ξ p where "s = (ξ, p)"
                      and "(ξ, p)  reachable (paodv i) TT"
      by (metis prod.exhaust)
    have "onl ΓAODV ?P (ξ, p)"
    proof (rule onlI)
      fix l
      assume "l  labels ΓAODV p"
      with (ξ, p)  reachable (paodv i) TT›
        have I1: "l  {PRreq-:18..PRreq-:20}  dip ξ  kD(rt ξ)"
         and I2: "l = PRreq-:19  oip ξ  kD(rt ξ)"
         and I3: "l  {PRrep-:2..PRrep-:6}   dip ξ  kD(rt ξ)"
         by (auto dest!: invariantD [OF addpreRT_partly_welldefined])
      moreover from (ξ, p)  reachable (paodv i) TT› l  labels ΓAODV p and I3
        have "l = PRrep-:6   (the (nhop (rt ξ) (dip ξ)))  kD(rt ξ)"
          by (auto dest!: invariantD [OF includes_nhip])
      ultimately show "?P (ξ, l)"
        by simp
    qed
    with s = (ξ, p) show "onl ΓAODV ?P s"
      by simp
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                 simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:19}
                                  {PPkt-:7..PPkt-:11}
                                  {PRreq-:11..PRreq-:15}
                                  {PRreq-:24..PRreq-:28}
                                  {PRrep-:10..PRrep-:14}
                                  {PRerr-:1..PRerr-:5}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:18..PRreq-:21}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:6, PRreq-:7}  dip ξ = ip ξ)
                             (l  {PRreq-:17..PRreq-:21}  dip ξ  ip ξ))"
  proof (inv_cterms, elim conjE)
    fix l ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:19}λξ. ξrt := the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}) p'
               sterms ΓAODV pp"
       and "l = PRreq-:19"
       and "dip ξ  vD (rt ξ)"
    from this(1-3) have "oip ξ  kD (rt ξ)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRreq-:19"])
    with ‹dip ξ  vD (rt ξ)
      show "dip ξ  vD (the (addpreRT (rt ξ) (oip ξ) {the (nhop (rt ξ) (dip ξ))}))" by simp
  qed

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN 
           invariant_restrict_inD]],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:20}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:20"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip, {})) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip, {})) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                            onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:18..PRreq-:20}  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3..PRreq-:9}  {PRreq-:17, PRreq-:30, PRreq-:32}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {}) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:2..PRrep-:7}  (dip ξ  kD(rt ξ)
                                         sqn (rt ξ) (dip ξ) = dsn ξ
                                         the (dhops (rt ξ) (dip ξ)) = Suc (hops ξ)
                                         the (flag (rt ξ) (dip ξ)) = val
                                         the (nhop (rt ξ) (dip ξ))  kD (rt ξ))))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rrep_1_update_changes]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD])
 
    have rreq_oip_kD: "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:3..PRreq-:28}  oip ξ  kD(rt ξ)))"
      by(inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]) 

    have rreq_dip_kD_oip_sqn: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:18..PRreq-:21}
                               (dip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val)))))"
      by(inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                             onl_invariant_sterms [OF aodv_wf addpreRT_welldefined])

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep]
                              onl_invariant_sterms [OF aodv_wf rreq_oip_kD]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_kD_oip_sqn])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:11,
                                            PRreq-:24, PRrep-:10, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:19}
                               {PPkt-:8..PPkt-:11}
                               {PRreq-:12..PRreq-:15}
                               {PRreq-:25..PRreq-:28}
                               {PRrep-:11..PRrep-:14}
                               {PRerr-:2..PRerr-:5}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:14  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:11, PRreq-:24, PRrep-:10}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf addpreRT_welldefined [THEN invariant_restrict_inD]])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:1}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ, {})"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory D_Quality_Increases

(*  Title:       variants/d_fwdrreqs/Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The quality increases predicate"

theory D_Quality_Increases
imports D_Aodv_Predicates D_Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc _ _ _ _ oipc osnc sipc _  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops rreqid dip dsn dsk oip osn sip handled.
           msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip handled) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops rreqid dip dsn dsk oip osn sip handled
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops rreqid dip dsn dsk oip osn sip handled)"
      and "rreq_rrep_sn (Rreq hops rreqid dip dsn dsk oip osn sip handled)"
  shows "msg_fresh σ (Rreq hops rreqid dip dsn dsk oip osn sip handled)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops rreqid dip dsn dsk oip osn sip handled
    assume [simp]: "m = Rreq hops rreqid dip dsn dsk oip osn sip handled"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory D_OAodv

(*  Title:       variants/d_fwdrreqs/OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory D_OAodv
imports D_Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory D_Global_Invariants

(*  Title:       variants/d_fwdrreqs/Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Global invariant proofs over sequential processes"

theory D_Global_Invariants
imports D_Seq_Invariants
        D_Aodv_Predicates
        D_Fresher
        D_Quality_Increases
        AWN.OAWN_Convert
        D_OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed

text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas oaddpreRT_welldefined =
         open_seq_invariant [OF addpreRT_welldefined initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i), {}))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i), {})) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i), {}))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip, {})) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by (clarsimp elim!: kD_quality_increases)
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip, {})) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip, {})) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip, {})) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip, {})) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip, {}))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip, {})) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {})) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip, {}) = rt (σ i)"

          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i, π7 (the (rt (σ i) oip)))
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oaddpreRT_welldefined]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_compare_next_hop:
  fixes w
  shows "opaodv i  (otherwith ((=)) {i} (orecvmsg msg_fresh),
                      other quality_increases {i} →)
                       global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                         in dip  kD(rt (σ i))  nhip  dip 
                                            dip  kD(rt (σ nhip))
                                             nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  by (rule oinvariant_weakenE [OF seq_compare_next_hop']) (auto dest!: onlD)

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory D_Loop_Freedom

(*  Title:       variants/d_fwdrreqs/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Routing graphs and loop freedom"

theory D_Loop_Freedom
imports D_Aodv_Predicates D_Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops pre.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip', pre)})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops pre. r dip = Some (dsn, dsk, val, hops, ip', pre)))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory D_Aodv_Loop_Freedom

(*  Title:       variants/d_fwdrreqs/Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory D_Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting D_Global_Invariants D_Loop_Freedom
begin

subsection ‹Lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory E_All_ABCD

(*  Title:       variants/e_all_abcd/E_All_ABCD.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible E_All_ABCD
imports "../../Aodv_Basic"
begin

chapter "Variants A--D: All proposed modifications"

text ‹
  This model combines the changes proposed in each of the individual variant 
  models.
›

end %invisible

Theory E_Aodv_Data

(*  Title:       variants/e_all_abcd/Aodv_Data.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Predicates and functions used in the AODV model"

theory E_Aodv_Data
imports E_All_ABCD
begin

subsection "Sequence Numbers"

text ‹Sequence numbers approximate the relative freshness of routing information.›

definition inc :: "sqn  sqn"
  where "inc sn  if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x  inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x  Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x  1"
  by simp

subsection "Modelling Routes"

text ‹
  A route is a t-tuple, @{term "(dsn, dsk, flag, hops, nhip)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, and @{term nhip} is the
  next hop toward the destination.
›

type_synonym r = "sqn × k × f × nat × ip"

definition proj2 :: "r  sqn" ("π2")
  where "π2  λ(dsn, _, _, _, _). dsn"

definition proj3 :: "r  k" ("π3")
  where "π3  λ(_, dsk, _, _, _). dsk"

definition proj4 :: "r  f" ("π4")
  where "π4  λ(_, _, flag, _, _). flag"

definition proj5 :: "r  nat" ("π5")
  where "π5  λ(_, _, _, hops, _). hops"

definition proj6 :: "r  ip" ("π6")
  where "π6  λ(_, _, _, _, nhip). nhip"

lemma projs [simp]:
  "π2(dsn, dsk, flag, hops, nhip) = dsn"
  "π3(dsn, dsk, flag, hops, nhip) = dsk"
  "π4(dsn, dsk, flag, hops, nhip) = flag"
  "π5(dsn, dsk, flag, hops, nhip) = hops"
  "π6(dsn, dsk, flag, hops, nhip) = nhip"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def)+

lemma proj3_pred [intro]: " P kno; P unk   P (π3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: " P val; P inv   P (π4 x)"
  by (rule f.induct)

lemma proj6_pair_snd [simp]:
  fixes dsn' r
  shows "π6 (dsn', snd (r)) = π6(r)"
  by (cases r) simp

subsection "Routing Tables"

text ‹Routing tables map ip addresses to route entries.›

type_synonym rt = "ip  r"

syntax
  "_Sigma_route" :: "rt  ip  r"  ("σroute'(_, _')")

translations
 route(rt, dip)" => "rt dip" 

definition sqn :: "rt  ip  sqn"
  where "sqn rt dip  case σroute(rt, dip) of Some r  π2(r) | None  0"

definition sqnf :: "rt  ip  k"
  where "sqnf rt dip  case σroute(rt, dip) of Some r  π3(r) | None  unk"

abbreviation flag :: "rt  ip  f"
  where "flag rt dip  map_option π4 (σroute(rt, dip))"

abbreviation dhops :: "rt  ip  nat"
   where "dhops rt dip  map_option π5 (σroute(rt, dip))"

abbreviation nhop :: "rt  ip  ip"
   where "nhop rt dip  map_option π6 (σroute(rt, dip))"

definition vD :: "rt  ip set"
  where "vD rt  {dip. flag rt dip = Some val}"

definition iD :: "rt  ip set"
  where "iD rt  {dip. flag rt dip = Some inv}"

definition kD :: "rt  ip set"
  where "kD rt  {dip. rt dip  None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt  iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "ip rt. ip  vD rt  ip  kD rt"
   "ip rt. ip  iD rt  ip  kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows "dsn dsk flag hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, flag, hops, nhip)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip  kD rt"
    shows route(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip  vD rt"
    shows "dsn dsk hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, val, hops, nhip)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip  iD rt"
    shows "dsn dsk hops nhip.
           σroute(rt, dip) = Some (dsn, dsk, inv, hops, nhip)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "ipvD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "ipiD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ipiD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from ipiD(rt) have "ipkD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)"
    shows "ipiD(rt)"
  proof -
    from ipkD(rt) obtain dsn dsk f hops nhop
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop)"
       by (metis kD_Some)
    from ipvD(rt) have "f  val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with ipkD(rt) show "ipvD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp  
    with ipkD(rt) show "ipiD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ipkD(rt)"
      and "ipvD(rt)  P rt ip"
      and "ipiD(rt)  P rt ip"
    shows "P rt ip"
  proof -
    from ipkD(rt) have "ipvD(rt)  iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "dip rt. dipkD(rt)  π5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "dip rt. dipkD(rt)  π4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "dip rt. dipkD(rt)  π2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "ip rt. ipkD(rt)  sqnf rt ip = π3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "dip rt. dip  vD (rt)  the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "rt nip v. kD (rt(nip  v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip'  ipkD(rt)"
      and "ip = ip'  P rt ip ip'"
      and " ip  ip'; ipkD(rt)  P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text ‹Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.›

subsubsection "Updating route entries"

lemma in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = es (the (rt dip))"
  using assms [THEN kD_Some] by auto

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "(case rt dip of None  en | Some r  es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip  kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r  bool"
where "update_arg_wf r  π4(r) = val 
                         (π2(r) = 0) = (π3(r) = unk) 
                         (π3(r) = unk  π5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "r. update_arg_wf r  (π2(r) = 0) = (π3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "nhip. update_arg_wf (0, unk, val, Suc 0, nhip)"
  "n hops nhip. update_arg_wf (Suc n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "n hops nhip. Suc 0  n  update_arg_wf (n, kno, val, hops,  nhip)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "nhip. P (0, unk, val, Suc 0, nhip)"
      and c2: "dsn hops nhip. dsn > 0  P (dsn, kno, val, hops, nhip)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip
    where *: "r = (dsn, dsk, flag, hops, nhip)" by (cases r)
    with ‹update_arg_wf r have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk  (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using flag = val› by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using flag = val› by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt  ip  r  rt"
  where
  "update rt ip r 
     case σroute(rt, ip) of
       None  rt (ip  r)
     | Some s 
          if π2(s) < π2(r) then rt (ip  r)
          else if π2(s) = π2(r)  (π5(s) > π5(r)  π4(s) = inv)
               then rt (ip  r)
               else if π3(r) = unk
                    then rt (ip  (π2(s), snd (r)))
                    else rt (ip  s)"

lemma update_simps [simp]:
  fixes r s nrt nr' ns rt ip
  defines "s  the σroute(rt, ip)"
      and "nr'  (π2(s), π3(r), π4(r), π5(r), π6(r))"
  shows
  "ip  kD(rt)                             update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip < π2(r)          update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 the (dhops rt ip) > π5(r)  update rt ip r = rt (ip  r)"
  "ip  kD(rt); sqn rt ip = π2(r);
                 flag rt ip = Some inv      update rt ip r = rt (ip  r)"
  "ip  kD(rt); π3(r) = unk; (π2(r) = 0) = (π3(r) = unk)   update rt ip r = rt (ip  nr')"
  "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
    sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val 
                                             update rt ip r = rt (ip  s)"
  proof -
    assume "ipkD(rt)"
    hence route(rt, ip) = None" ..
    thus "update rt ip r = rt (ip  r)"
      unfolding update_def by simp
  next
    assume "ip  kD(rt)"
       and "sqn rt ip < π2(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with ‹sqn rt ip < π2(r) show "update rt ip r = rt (ip  r)"
      unfolding update_def s_def by auto
  next
    assume "ip  kD(rt)"
       and "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with ‹sqn rt ip = π2(r) and ‹the (dhops rt ip) > π5(r)
      show "update rt ip r = rt (ip  r)"
        unfolding update_def s_def by auto
   next
     assume "ip  kD(rt)"
        and "sqn rt ip = π2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)        
     with ‹sqn rt ip = π2(r) and ‹flag rt ip = Some inv›
      show "update rt ip r = rt (ip  r)"
        unfolding update_def s_def by auto
   next
    assume "ip  kD(rt)"
       and "π3(r) = unk"
       and "(π2(r) = 0) = (π3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    with (π2(r) = 0) = (π3(r) = unk) and π3(r) = unk›
      show "update rt ip r = rt (ip  nr')"
        unfolding update_def nr'_def s_def
      by (cases r) simp
   next
    assume "ip  kD(rt)"
       and otherassms: "sqn rt ip  π2(r)"
           "π3(r) = kno"
           "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip
      where "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip  s)"
      unfolding update_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and c1: "ip  kD(rt)  P (rt (ip  r))"

      and c2: "ip  kD(rt); sqn rt ip < π2(r)
                 P (rt (ip  r ))"
      and c3: "ip  kD(rt); sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  r ))"
      and c4: "ip  kD(rt); sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  r ))"
      and c5: "ip  kD(rt); π3(r) = unk
                 P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                  π4(r), π5(r), π6(r))))"
      and c6: "ip  kD(rt); sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  the σroute(rt, ip)))"
  shows "(P (update rt ip r))"
  proof (cases "ip  kD(rt)")
    assume "ip  kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip  kD(rt)"
    moreover then obtain dsn dsk fl hops nhip
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip'
      where req: "r = (dsn', dsk', fl', hops', nhip')"
        by (cases r) metis
    ultimately show ?thesis
      using (π2(r) = 0) = (π3(r) = unk)
            c2 [OF ipkD(rt)]
            c3 [OF ipkD(rt)]
            c4 [OF ipkD(rt)]
            c5 [OF ipkD(rt)]
            c6 [OF ipkD(rt)]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(π2(r) = 0) = (π3(r) = unk)"
      and "ip  kD(rt)"
      and c2: "sqn rt ip < π2(r)  P (rt (ip  r ))"
      and c3: "sqn rt ip = π2(r); the (dhops rt ip) > π5(r)
                 P (rt (ip  r ))"
      and c4: "sqn rt ip = π2(r); the (flag rt ip) = inv
                 P (rt (ip  r ))"
      and c5: "π3(r) = unk  P (rt (ip  (π2(the σroute(rt, ip)), π3(r),
                                            π4(r), π5(r), π6(r))))"
      and c6: "sqn rt ip  π2(r); π3(r) = kno;
                sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val
                 P (rt (ip  the σroute(rt, ip)))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < π2(r)"
    thus "P (rt(ip  r))" by (rule c2)
  next
    assume "sqn rt ip = π2(r)"
       and "the (dhops rt ip) > π5(r)"
    thus "P (rt(ip  r))"
      by (rule c3)
  next
    assume "sqn rt ip = π2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip  r))"
      by (rule c4)
  next
    assume "π3(r) = unk"
    thus "P (rt (ip  (π2(the σroute(rt, ip)), π3(r), π4(r), π5(r), π6(r))))"
      by (rule c5)
  next
    assume "sqn rt ip  π2(r)"
       and "π3(r) = kno"
       and "sqn rt ip = π2(r)  the (dhops rt ip)  π5(r)  the (flag rt ip) = val"
    thus "P (rt (ip  the (rt ip)))"
      by (rule c6)
  qed (simp add: ip  kD(rt))

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt  update rt dip (dsn, dsk, flag, hops, nhip)"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip)) dip) = nhip"
  proof -
  from assms
  have update_neq: "v. rt dip = Some v 
          update rt dip (dsn, dsk, flag, hops, nhip)
              rt(dip  the (rt dip))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip  None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (λx. if x = rip then Some v else rt x) ip
         = (if ip = rip then π2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip  sqn (update rt rip (dsn, dsk, val, hops, nhip)) dip"
  proof (rule update_cases)
    show "(π2 (dsn, dsk, val, hops, nhip) = 0) = (π3 (dsn, dsk, val, hops, nhip) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip
  assumes "1  hops"
    shows "sqn rt ip  sqn (update rt ip' (dsn, dsk, flag, hops, nhip)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip
  assumes ex: "ipkD rt. the (dhops rt ip)  1"
      and ip: "(ip = rip  Suc 0  hops)  (ip  rip  ipkD rt)"
    shows "Suc 0  the (dhops (update rt rip (dsn, dsk, flag, hops, nhip)) ip)"
  using ip proof
    assume "ip = rip  Suc 0  hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip  kD rt") (drule(1) bspec, auto)
  next
    assume "ip  rip  ipkD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "ripkD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "rt ip dsn dsk flag hops nhip. sqn (rt(ip  v)) ip = π2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt  update rt dip (osn, kno, val, hops, nhip)"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip)) dip) = hops"
  using assms unfolding update_def                                                      
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_unk_val [simp]:
  "rt dip ip dsn hops.
   the (nhop (update rt dip (dsn, unk, val, hops, ip)) dip) = ip"
   unfolding update_def by (clarsimp split: option.split)

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip)  rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip))
   =
   (¬(rt = update rt ip (dsn, dsk, flag, hops, sip)  ¬P rt
       rt  update rt ip (dsn, dsk, flag, hops, sip)
          ¬P (update rt ip (dsn, dsk, flag, hops, sip))))"
  by auto

lemma sqn_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip)
   sqn (update rt dip (dsn, kno, flg, hops, sip)) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   sqnf (update rt dip (dsn, dsk, flg, hops, sip)) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "rt dip ip dsn hops. 1  dsn  1  (sqn (update rt dip (dsn, kno, val, hops, ip)) dip)"
   unfolding update_def 
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   π3(the (update rt dip (dsn, dsk, flg, hops, sip) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip)
    the (nhop (update rt ip (dsn, kno, val, hops, nhip)) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "rt dip dsn flg hops sip.
  rt  update rt dip (dsn, kno, flg, hops, sip)
   the (flag (update rt dip (dsn, kno, flg, hops, sip)) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip  kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip)"
    shows "dipkD(rt)"
  proof -
    have "dipkD(update rt dip (dsn, dsk, flag, hops, nhip))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "rt dip dsn dsk flg hops sip.
  rt  update rt dip (dsn, dsk, flg, hops, sip)
   the (nhop (update rt dip (dsn, dsk, flg, hops, sip)) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma sqnf_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip
  assumes "ip  dip"
    shows "sqnf (update rt dip (dsn, dsk, flag, hops, nhip)) ip = sqnf rt ip"
  using assms unfolding update_def sqnf_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "dip rt dip' dsn dsk hops nhip.
   dip  vD(update rt dip' (dsn, dsk, val, hops, nhip))  (dipvD(rt)  dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt  (ip  sqn)  rt"
where "invalidate rt dests 
  λip. case (rt ip, dests ip) of
    (None, _)  None
  | (Some s, None)  Some s
  | (Some (_, dsk, _, hops, nhip), Some rsn) 
                      Some (rsn, dsk, inv, hops, nhip)"

lemma proj3_invalidate [simp]:
  "dip. π3(the ((invalidate rt dests) dip)) = π3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "dip. π5(the ((invalidate rt dests) dip)) = π5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "dip. π6(the ((invalidate rt dests) dip)) = π6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)


subsection "Route Requests"

lemma invalidate_kD_inv [simp]:
  "rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "rsn. dests dip = Some rsn  sqn rt dip  rsn"
  shows "sqn rt dip  sqn (invalidate rt dests) dip"
  proof (cases "dip  kD(rt)")
    assume "¬ dip  kD(rt)"
    hence "dipkD(rt)" by simp
    then obtain dsn dsk flag hops nhip where "rt dip = Some (dsn, dsk, flag, hops, nhip)"
      by (metis kD_Some)
    with assms show "sqn rt dip  sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipakD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "dip. sqnf (invalidate (rt ξ) (dests ξ)) dip = sqnf (rt ξ) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "dip. the (nhop (invalidate (rt ξ) (dests ξ)) dip) = the (nhop (rt ξ) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dipdom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dipkD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "dip rt dests. dipvD(invalidate rt dests)  dipvD(rt)  dests dip = None"
  unfolding invalidate_def vD_def 
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dipdom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip)"
    shows "  dsn = (case dests dip of None  π2(the (rt dip)) | Some rsn  rsn)
            dsk = π3(the (rt dip))
            flag = (if dests dip = None then π4(the (rt dip)) else inv)
            hops = π5(the (rt dip))
            nhip = π6(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto

lemma proj3_inv: "dip rt dests. dipkD (rt)
                       π3(the (invalidate rt dests dip)) = π3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ipkD(rt)"
    shows "ipiD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Queued Packets"

text ‹Functions for sending data packets.›

type_synonym store = "ip  (p × data list)"

definition sigma_queue :: "store  ip  data list"    ("σqueue'(_, _')")
  where queue(store, dip)  case store dip of None  [] | Some (p, q)  q"

definition qD :: "store  ip set"
  where "qD  dom"

definition add :: "data  ip  store  store"
  where "add d dip store  case store dip of
                              None  store (dip  (req, [d]))
                            | Some (p, q)  store (dip  (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip  store  store"
  where "drop dip store 
    map_option (λ(p, q). if tl q = [] then store (dip := None)
                                      else store (dip  (p, tl q))) (store dip)"

definition sigma_p_flag :: "store  ip  p" ("σp-flag'(_, _')")
  where p-flag(store, dip)  map_option fst (store dip)"

definition unsetRRF :: "store  ip  store"
  where "unsetRRF store dip  case store dip of
                                None  store
                              | Some (p, q)  store (dip  (noreq, q))"

definition setRRF :: "store  (ip  sqn)  store"
  where "setRRF store dests  λdip. if dests dip = None then store dip
                                    else map_option (λ(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text ‹
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term p-flag(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip  r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
›

end

Theory E_Aodv_Message

(*  Title:       variants/e_all_abcd/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "AODV protocol messages"

theory E_Aodv_Message
imports E_All_ABCD
begin

datatype msg =
    Rreq nat ip sqn k ip sqn ip bool
  | Rrep nat ip sqn ip ip
  | Rerr "ip  sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt  λ(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m  case m of Newpkt d dip  True | _  False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text ‹The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.›

definition rreq :: "nat × ip × sqn × k × ip × sqn × ip × bool  msg"
  where "rreq  λ(hops, dip, dsn, dsk, oip, osn, sip, handled).
                    Rreq hops dip dsn dsk oip osn sip handled"

lemma rreq_simp [simp]:
  "rreq(hops, dip, dsn, dsk, oip, osn, sip, handled) =  Rreq hops dip dsn dsk oip osn sip handled"
  unfolding rreq_def by simp

definition rrep :: "nat × ip × sqn × ip × ip  msg"
  where "rrep  λ(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip  sqn) × ip  msg"
  where "rerr  λ(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "¬eq_newpkt (Rreq hops dip dsn dsk oip osn sip handled)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "¬eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "¬eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "¬eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data × ip × ip  msg"
  where "pkt  λ(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end

Theory E_Aodv

(*  Title:       variants/e_all_abcd/Aodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The AODV protocol"

theory E_Aodv
imports E_Aodv_Data E_Aodv_Message
        AWN.AWN_SOS_Labels AWN.AWN_Invariants
begin

subsection "Data state"

record state =
  ip    :: "ip"
  sn    :: "sqn"
  rt    :: "rt" 
  rreqs :: "(ip × sqn) set"
  store :: "store"
  (* all locals *)
  msg    :: "msg"
  data   :: "data"
  dests  :: "ip  sqn"

  dip    :: "ip"
  oip    :: "ip"
  hops   :: "nat"
  dsn    :: "sqn"
  dsk    :: "k"
  osn    :: "sqn"
  sip    :: "ip"
  handled:: "bool"

abbreviation aodv_init :: "ip  state"
where "aodv_init i  
         ip = i,
         sn = 1,
         rt = Map.empty,
         rreqs = {},
         store = Map.empty,

         msg    = (SOME x. True),
         data   = (SOME x. True),
         dests  = (SOME x. True),

         dip    = (SOME x. True),
         oip    = (SOME x. True),
         hops   = (SOME x. True),
         dsn    = (SOME x. True),
         dsk    = (SOME x. True),
         osn    = (SOME x. True),
         sip    = (SOME x. x  i),
         handled= (SOME x. True)
       "

lemma some_neq_not_eq [simp]: "¬((SOME x :: nat. x  i) = i)"
  by (subst some_eq_ex) (metis zero_neq_numeral)

definition clear_locals :: "state  state"
where "clear_locals ξ = ξ 
    msg    := (SOME x. True),
    data   := (SOME x. True),
    dests  := (SOME x. True),

    dip    := (SOME x. True),
    oip    := (SOME x. True),
    hops   := (SOME x. True),
    dsn    := (SOME x. True),
    dsk    := (SOME x. True),
    osn    := (SOME x. True),
    sip    := (SOME x. x  ip ξ),
    handled:= (SOME x. True)
  "

lemma clear_locals_sip_not_ip [simp]: "¬(sip (clear_locals ξ) = ip ξ)"
  unfolding clear_locals_def by simp

lemma clear_locals_but_not_globals [simp]:
  "ip (clear_locals ξ) = ip ξ"
  "sn (clear_locals ξ) = sn ξ"
  "rt (clear_locals ξ) = rt ξ"
  "rreqs (clear_locals ξ) = rreqs ξ"
  "store (clear_locals ξ) = store ξ"
  unfolding clear_locals_def by auto

subsection "Auxilliary message handling definitions"

definition is_newpkt
where "is_newpkt ξ  case msg ξ of
                       Newpkt data' dip'  { ξdata := data', dip := dip' }
                     | _  {}"

definition is_pkt
where "is_pkt ξ  case msg ξ of
                    Pkt data' dip' oip'  { ξ data := data', dip := dip', oip := oip'  }
                  | _  {}"

definition is_rreq
where "is_rreq ξ  case msg ξ of
                     Rreq hops' dip' dsn' dsk' oip' osn' sip' handled' 
                       { ξ hops := hops', dip := dip', dsn := dsn',
                            dsk := dsk', oip := oip', osn := osn', sip := sip', 
                            handled := handled'  }
                   | _  {}"

lemma is_rreq_asm [dest!]:
  assumes "ξ'  is_rreq ξ"
    shows "(hops' dip' dsn' dsk' oip' osn' sip' handled'.
               msg ξ = Rreq hops' dip' dsn' dsk' oip' osn' sip' handled' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn',
                       dsk := dsk', oip := oip', osn := osn', sip := sip', 
                       handled := handled' )"
  using assms unfolding is_rreq_def
  by (cases "msg ξ") simp_all

definition is_rrep
where "is_rrep ξ  case msg ξ of
                     Rrep hops' dip' dsn' oip' sip' 
                       { ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip'  }
                   | _  {}"

lemma is_rrep_asm [dest!]:
  assumes "ξ'  is_rrep ξ"
    shows "(hops' dip' dsn' oip' sip'.
               msg ξ = Rrep hops' dip' dsn' oip' sip' 
               ξ' = ξ hops := hops', dip := dip', dsn := dsn', oip := oip', sip := sip' )"
  using assms unfolding is_rrep_def
  by (cases "msg ξ") simp_all

definition is_rerr
where "is_rerr ξ  case msg ξ of
                     Rerr dests' sip'  { ξ dests := dests', sip := sip'  }
                   | _  {}"

lemma is_rerr_asm [dest!]:
  assumes "ξ'  is_rerr ξ"
    shows "(dests' sip'.
               msg ξ = Rerr dests' sip' 
               ξ' = ξ dests := dests', sip := sip' )"
  using assms unfolding is_rerr_def
  by (cases "msg ξ") simp_all

lemmas is_msg_defs =
  is_rerr_def is_rrep_def is_rreq_def is_pkt_def is_newpkt_def

lemma is_msg_inv_ip [simp]:
  "ξ'  is_rerr ξ    ip ξ' = ip ξ"
  "ξ'  is_rrep ξ    ip ξ' = ip ξ"
  "ξ'  is_rreq ξ    ip ξ' = ip ξ"
  "ξ'  is_pkt ξ     ip ξ' = ip ξ"
  "ξ'  is_newpkt ξ  ip ξ' = ip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sn [simp]:
  "ξ'  is_rerr ξ    sn ξ' = sn ξ"
  "ξ'  is_rrep ξ    sn ξ' = sn ξ"
  "ξ'  is_rreq ξ    sn ξ' = sn ξ"
  "ξ'  is_pkt ξ     sn ξ' = sn ξ"
  "ξ'  is_newpkt ξ  sn ξ' = sn ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rt [simp]:
  "ξ'  is_rerr ξ    rt ξ' = rt ξ"
  "ξ'  is_rrep ξ    rt ξ' = rt ξ"
  "ξ'  is_rreq ξ    rt ξ' = rt ξ"
  "ξ'  is_pkt ξ     rt ξ' = rt ξ"
  "ξ'  is_newpkt ξ  rt ξ' = rt ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_rreqs [simp]:
  "ξ'  is_rerr ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rrep ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_rreq ξ    rreqs ξ' = rreqs ξ"
  "ξ'  is_pkt ξ     rreqs ξ' = rreqs ξ"
  "ξ'  is_newpkt ξ  rreqs ξ' = rreqs ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_store [simp]:
  "ξ'  is_rerr ξ    store ξ' = store ξ"
  "ξ'  is_rrep ξ    store ξ' = store ξ"
  "ξ'  is_rreq ξ    store ξ' = store ξ"
  "ξ'  is_pkt ξ     store ξ' = store ξ"
  "ξ'  is_newpkt ξ  store ξ' = store ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

lemma is_msg_inv_sip [simp]:
  "ξ'  is_pkt ξ     sip ξ' = sip ξ"
  "ξ'  is_newpkt ξ  sip ξ' = sip ξ"
  unfolding is_msg_defs
  by (cases "msg ξ", clarsimp+)+

subsection "The protocol process"

datatype pseqp =
    PAodv
  | PNewPkt
  | PPkt
  | PRreq
  | PRrep
  | PRerr

fun nat_of_seqp :: "pseqp  nat"
where
  "nat_of_seqp PAodv  = 1"
| "nat_of_seqp PPkt   = 2"
| "nat_of_seqp PNewPkt   = 3"
| "nat_of_seqp PRreq  = 4"
| "nat_of_seqp PRrep  = 5"
| "nat_of_seqp PRerr  = 6"

instantiation "pseqp" :: ord
begin
definition less_eq_seqp [iff]: "l1  l2 = (nat_of_seqp l1  nat_of_seqp l2)"
definition less_seqp [iff]:    "l1 < l2 = (nat_of_seqp l1 < nat_of_seqp l2)"
instance ..
end

abbreviation AODV
where
  "AODV  λ_. clear_locals call(PAodv)"

abbreviation PKT
where
  "PKT args 

     ξ. let (data, dip, oip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip, oip := oip 
     call(PPkt)"
abbreviation NEWPKT
where
  "NEWPKT args 
     ξ. let (data, dip) = args ξ in
         (clear_locals ξ)  data := data, dip := dip 
     call(PNewPkt)"

abbreviation RREQ
where
  "RREQ args 
     ξ. let (hops, dip, dsn, dsk, oip, osn, sip, handled) = args ξ in
         (clear_locals ξ)  hops := hops,  dip := dip,
                            dsn := dsn, dsk := dsk, oip := oip,
                            osn := osn, sip := sip, handled := handled 
     call(PRreq)"

abbreviation RREP
where
  "RREP args 
     ξ. let (hops, dip, dsn, oip, sip) = args ξ in
         (clear_locals ξ)  hops := hops, dip := dip, dsn := dsn,
                            oip := oip, sip := sip 
     call(PRrep)"

abbreviation RERR
where
  "RERR args 
     ξ. let (dests, sip) = args ξ in
         (clear_locals ξ)  dests := dests, sip := sip 
     call(PRerr)"

fun ΓAODV :: "(state, msg, pseqp, pseqp label) seqp_env"
where
  "ΓAODV PAodv = labelled PAodv (
     receive(λmsg' ξ. ξ  msg := msg' ).
     (    is_newpkt NEWPKT(λξ. (data ξ, ip ξ))
        is_pkt PKT(λξ. (data ξ, dip ξ, oip ξ))
        is_rreq
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RREQ(λξ. (hops ξ, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, sip ξ, handled ξ))
        is_rrep
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RREP(λξ. (hops ξ, dip ξ, dsn ξ, oip ξ, sip ξ))
        is_rerr
            ξ. ξ rt := update (rt ξ) (sip ξ) (0, unk, val, 1, sip ξ) 
            RERR(λξ. (dests ξ, sip ξ))
     )
      λξ. { ξ dip := dip  | dip. dip  qD(store ξ)  vD(rt ξ) }
          ξ. ξ  data := hd(σqueue(store ξ, dip ξ)) 
          unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, ip ξ)).
            ξ. ξ  store := the (drop (dip ξ) (store ξ)) 
            AODV()
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)). AODV()
      λξ. { ξ dip := dip 
             | dip. dip  qD(store ξ) - vD(rt ξ)  the (σp-flag(store ξ, dip)) = req }
         ξ. ξ  store := unsetRRF (store ξ) (dip ξ) 
         ξ. ξ  sn := inc (sn ξ) 
         ξ. ξ  rreqs := rreqs ξ  {(ip ξ, sn ξ)} 
         broadcast(λξ. rreq(0, dip ξ, sqn (rt ξ) (dip ξ), sqnf (rt ξ) (dip ξ), ip ξ, sn ξ,
                            ip ξ, False)). AODV())"

|  "ΓAODV PNewPkt = labelled PNewPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
        ξ. ξ  store := add (data ξ) (dip ξ) (store ξ) 
        AODV())"

| "ΓAODV PPkt = labelled PPkt (
     ξ. dip ξ = ip ξ
        deliver(λξ. data ξ).AODV()
      ξ. dip ξ  ip ξ
     (
       ξ. dip ξ  vD (rt ξ)
         unicast(λξ. the (nhop (rt ξ) (dip ξ)), λξ. pkt(data ξ, dip ξ, oip ξ)).AODV()
         
           ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (dip ξ))
                                   then Some (inc (sqn (rt ξ) rip)) else None) 
           ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
           ξ. ξ  store := setRRF (store ξ) (dests ξ)
           broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
        ξ. dip ξ  vD (rt ξ)
       (
           ξ. dip ξ  iD (rt ξ)
             broadcast(λξ. rerr([dip ξ  sqn (rt ξ) (dip ξ)], ip ξ)). AODV()
            ξ. dip ξ  iD (rt ξ)
              AODV()
       )
     ))"

| "ΓAODV PRreq = labelled PRreq (
     ξ. (oip ξ, osn ξ)  rreqs ξ
       AODV()
      ξ. (oip ξ, osn ξ)  rreqs ξ
       ξ. ξ  rt := update (rt ξ) (oip ξ) (osn ξ, kno, val, hops ξ + 1, sip ξ) 
       ξ. ξ  rreqs := rreqs ξ  {(oip ξ, osn ξ)} 
       (
         ξ. handled ξ = False
         (
           ξ. dip ξ = ip ξ
             ξ. ξ  sn := max (sn ξ) (dsn ξ) 
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(0, dip ξ, sn ξ, oip ξ, ip ξ)).
               broadcast(λξ. rreq(hops ξ + 1, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, ip ξ, True)).
               AODV()
             
               ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                       then Some (inc (sqn (rt ξ) rip)) else None) 
               ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
               ξ. ξ  store := setRRF (store ξ) (dests ξ)
               broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. dip ξ  ip ξ
           (
             ξ. dip ξ  vD (rt ξ)  dsn ξ  sqn (rt ξ) (dip ξ)  sqnf (rt ξ) (dip ξ) = kno
               unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                                                               sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
                 broadcast(λξ. rreq(hops ξ + 1, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, ip ξ, True)).
                 AODV()
             
               ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                       then Some (inc (sqn (rt ξ) rip)) else None) 
               ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
               ξ. ξ  store := setRRF (store ξ) (dests ξ)
               broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
              ξ. dip ξ  vD (rt ξ)  sqn (rt ξ) (dip ξ) < dsn ξ  sqnf (rt ξ) (dip ξ) = unk
               broadcast(λξ. rreq(hops ξ + 1, dip ξ, max (sqn (rt ξ) (dip ξ)) (dsn ξ),
                                  dsk ξ, oip ξ, osn ξ, ip ξ, False)).
               AODV()
           )
         )
          ξ. handled ξ = True
           broadcast(λξ. rreq(hops ξ + 1, dip ξ, dsn ξ, dsk ξ, oip ξ, osn ξ, ip ξ, True)).
           AODV()
       ))"

| "ΓAODV PRrep = labelled PRrep (
       ξ. ξ  rt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, hops ξ + 1, sip ξ)  
       (
         ξ. oip ξ = ip ξ 
            AODV()
          ξ. oip ξ  ip ξ 
         (
           ξ. oip ξ  vD (rt ξ)  dip ξ  vD (rt ξ)
             unicast(λξ. the (nhop (rt ξ) (oip ξ)), λξ. rrep(the (dhops (rt ξ) (dip ξ)), dip ξ,
                                                             sqn (rt ξ) (dip ξ), oip ξ, ip ξ)).
             AODV()
           
             ξ. ξ  dests := (λrip. if (rip  vD (rt ξ)  nhop (rt ξ) rip = nhop (rt ξ) (oip ξ))
                                     then Some (inc (sqn (rt ξ) rip)) else None) 
             ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
             ξ. ξ  store := setRRF (store ξ) (dests ξ)
             broadcast(λξ. rerr(dests ξ, ip ξ)).AODV()
            ξ. oip ξ  vD (rt ξ)   dip ξ  vD (rt ξ)
             AODV()
         )
       )
     )"

| "ΓAODV PRerr = labelled PRerr (
     ξ. ξ  dests := (λrip. case (dests ξ) rip of None  None
                       | Some rsn  if rip  vD (rt ξ)  the (nhop (rt ξ) rip) = sip ξ
                                        sqn (rt ξ) rip < rsn then Some rsn else None) 
     ξ. ξ  rt := invalidate (rt ξ) (dests ξ) 
     ξ. ξ  store := setRRF (store ξ) (dests ξ)
     (
        ξ. dests ξ  Map.empty
          broadcast(λξ. rerr(dests ξ, ip ξ)). AODV()
         ξ. dests ξ = Map.empty 
          AODV()
     ))"


declare ΓAODV.simps [simp del, code del]
lemmas ΓAODV_simps [simp, code] = ΓAODV.simps [simplified]

fun ΓAODV_skeleton
where
    "ΓAODV_skeleton PAodv   = seqp_skeleton (ΓAODV PAodv)"
  | "ΓAODV_skeleton PNewPkt = seqp_skeleton (ΓAODV PNewPkt)"
  | "ΓAODV_skeleton PPkt    = seqp_skeleton (ΓAODV PPkt)"
  | "ΓAODV_skeleton PRreq   = seqp_skeleton (ΓAODV PRreq)"
  | "ΓAODV_skeleton PRrep   = seqp_skeleton (ΓAODV PRrep)"
  | "ΓAODV_skeleton PRerr   = seqp_skeleton (ΓAODV PRerr)"

lemma ΓAODV_skeleton_wf [simp]:
  "wellformed ΓAODV_skeleton"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV_skeleton pn)"
      by (cases pn) simp_all
  qed

declare ΓAODV_skeleton.simps [simp del, code del]
lemmas ΓAODV_skeleton_simps [simp, code]
           = ΓAODV_skeleton.simps [simplified ΓAODV_simps seqp_skeleton.simps]

lemma aodv_proc_cases [dest]:
  fixes p pn
  shows "p  ctermsl (ΓAODV pn) 
                                (p  ctermsl (ΓAODV PAodv)  
                                 p  ctermsl (ΓAODV PNewPkt)  
                                 p  ctermsl (ΓAODV PPkt)  
                                 p  ctermsl (ΓAODV PRreq) 
                                 p  ctermsl (ΓAODV PRrep) 
                                 p  ctermsl (ΓAODV PRerr))"
  by (cases pn) simp_all

definition σAODV :: "ip  (state × (state, msg, pseqp, pseqp label) seqp) set"
where "σAODV i  {(aodv_init i, ΓAODV PAodv)}"

abbreviation paodv
  :: "ip  (state × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "paodv i   init = σAODV i, trans = seqp_sos ΓAODV "

lemma aodv_trans: "trans (paodv i) = seqp_sos ΓAODV"
  by simp

lemma aodv_control_within [simp]: "control_within ΓAODV (init (paodv i))"
  unfolding σAODV_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma aodv_wf [simp]:
  "wellformed ΓAODV"
  proof (rule, intro allI)
    fix pn pn'
    show "call(pn')  stermsl (ΓAODV pn)"
      by (cases pn) simp_all
  qed

lemmas aodv_labels_not_empty [simp] = labels_not_empty [OF aodv_wf]

lemma aodv_ex_label [intro]: "l. llabels ΓAODV p"
  by (metis aodv_labels_not_empty all_not_in_conv)

lemma aodv_ex_labelE [elim]:
  assumes "llabels ΓAODV p. P l p"
      and "p l. P l p  Q"
    shows "Q"
  using assms by (metis aodv_ex_label)

lemma aodv_simple_labels [simp]: "simple_labels ΓAODV"
  proof
    fix pn p
    assume "psubterms(ΓAODV pn)"
    thus "∃!l. labels ΓAODV p = {l}"
    by (cases pn) (simp_all cong: seqp_congs | elim disjE)+
  qed

lemma σAODV_labels [simp]: "(ξ, p)  σAODV i   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV_def by simp

lemma aodv_init_kD_empty [simp]:
  "(ξ, p)  σAODV i  kD (rt ξ) = {}"
  unfolding σAODV_def kD_def by simp

lemma aodv_init_sip_not_ip [simp]: "¬(sip (aodv_init i) = i)" by simp

lemma aodv_init_sip_not_ip' [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  ip ξ"
  using assms unfolding σAODV_def by simp

lemma aodv_init_sip_not_i [simp]:
  assumes "(ξ, p)  σAODV i"
    shows "sip ξ  i"
  using assms unfolding σAODV_def by simp

lemma clear_locals_sip_not_ip':
  assumes "ip ξ = i"
    shows "¬(sip (clear_locals ξ) = i)"
  using assms by auto

text ‹Stop the simplifier from descending into process terms.›
declare seqp_congs [cong]

text ‹Configure the main invariant tactic for AODV.›

declare
  ΓAODV_simps [cterms_env]
  aodv_proc_cases [ctermsl_cases]
  seq_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                            cterms_intros]
  seq_step_invariant_ctermsI [OF aodv_wf aodv_control_within aodv_simple_labels aodv_trans,
                                 cterms_intros]

end

Theory E_Aodv_Predicates

(*  Title:       variants/e_all_abcd/Aodv_Predicates.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant assumptions and properties"

theory E_Aodv_Predicates
imports E_Aodv
begin

text ‹Definitions for expression assumptions on incoming messages and properties of
      outgoing messages.›

abbreviation not_Pkt :: "msg  bool"
where "not_Pkt m  case m of Pkt _ _ _  False | _  True"

definition msg_sender :: "msg  ip"
where "msg_sender m  case m of Rreq _ _ _ _ _ _ ipc _  ipc
                              | Rrep _ _ _ _ ipc  ipc
                              | Rerr _ ipc  ipc
                              | Pkt _ _ ipc  ipc"

lemma msg_sender_simps [simp]:
  "hops dip dsn dsk oip osn sip handled.
                          msg_sender (Rreq hops dip dsn dsk oip osn sip handled) = sip"
  "hops dip dsn oip sip. msg_sender (Rrep hops dip dsn oip sip) = sip"
  "dests sip.            msg_sender (Rerr dests sip) = sip"
  "d dip sip.            msg_sender (Pkt d dip sip) = sip"
  unfolding msg_sender_def by simp_all

definition msg_zhops :: "msg  bool"
where "msg_zhops m  case m of
                                 Rreq hopsc dipc _ _ oipc _ sipc _  hopsc = 0  oipc = sipc
                               | Rrep hopsc dipc _ _ sipc  hopsc = 0  dipc = sipc
                               | _  True"

lemma msg_zhops_simps [simp]:
  "hops dip dsn dsk oip osn sip handled.
           msg_zhops (Rreq hops dip dsn dsk oip osn sip handled) = (hops = 0  oip = sip)"
  "hops dip dsn oip sip. msg_zhops (Rrep hops dip dsn oip sip) = (hops = 0  dip = sip)"
  "dests sip.            msg_zhops (Rerr dests sip)        = True"
  "d dip.                msg_zhops (Newpkt d dip)          = True"
  "d dip sip.            msg_zhops (Pkt d dip sip)         = True"
  unfolding msg_zhops_def by simp_all

definition rreq_rrep_sn :: "msg  bool"
where "rreq_rrep_sn m  case m of Rreq _ _ _ _ _ osnc _ _  osnc  1
                                | Rrep _ _ dsnc _ _  dsnc  1
                                | _  True"

lemma rreq_rrep_sn_simps [simp]:
  "hops dip dsn dsk oip osn sip handled.
           rreq_rrep_sn (Rreq hops dip dsn dsk oip osn sip handled) = (osn  1)"
  "hops dip dsn oip sip. rreq_rrep_sn (Rrep hops dip dsn oip sip) = (dsn  1)"
  "dests sip.            rreq_rrep_sn (Rerr dests sip) = True"
  "d dip.                rreq_rrep_sn (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_sn (Pkt d dip sip)  = True"
  unfolding rreq_rrep_sn_def by simp_all

definition rreq_rrep_fresh :: "rt  msg  bool"
where "rreq_rrep_fresh crt m  case m of Rreq hopsc _ _ _ oipc osnc ipcc _  (ipcc  oipc 
                                                oipckD(crt)  (sqn crt oipc > osnc
                                                                 (sqn crt oipc = osnc
                                                                    the (dhops crt oipc)  hopsc
                                                                    the (flag crt oipc) = val)))
                                | Rrep hopsc dipc dsnc _ ipcc  (ipcc  dipc  
                                                                    dipckD(crt)
                                                                   sqn crt dipc = dsnc
                                                                   the (dhops crt dipc) = hopsc
                                                                   the (flag crt dipc) = val)
                                | _  True"

lemma rreq_rrep_fresh [simp]:
  "hops dip dsn dsk oip osn sip handled.
           rreq_rrep_fresh crt (Rreq hops dip dsn dsk oip osn sip handled) =
                               (sip  oip  oipkD(crt)
                                             (sqn crt oip > osn
                                                (sqn crt oip = osn
                                                   the (dhops crt oip)  hops
                                                   the (flag crt oip) = val)))"
  "hops dip dsn oip sip. rreq_rrep_fresh crt (Rrep hops dip dsn oip sip) =
                               (sip  dip  dipkD(crt)
                                               sqn crt dip = dsn
                                               the (dhops crt dip) = hops
                                               the (flag crt dip) = val)"
  "dests sip.            rreq_rrep_fresh crt (Rerr dests sip) = True"
  "d dip.                rreq_rrep_fresh crt (Newpkt d dip)   = True"
  "d dip sip.            rreq_rrep_fresh crt (Pkt d dip sip)  = True"
  unfolding rreq_rrep_fresh_def by simp_all

definition rerr_invalid :: "rt  msg  bool"
where "rerr_invalid crt m  case m of Rerr destsc _  (ripcdom(destsc).
                                            (ripciD(crt)  the (destsc ripc) = sqn crt ripc))
                                | _  True"

lemma rerr_invalid [simp]:
  "hops dip dsn dsk oip osn sip handled.
                           rerr_invalid crt (Rreq hops dip dsn dsk oip osn sip handled) = True"
  "hops dip dsn oip sip. rerr_invalid crt (Rrep hops dip dsn oip sip) = True"
  "dests sip.            rerr_invalid crt (Rerr dests sip) = (ripdom(dests).
                                                 ripiD(crt)  the (dests rip) = sqn crt rip)"
  "d dip.                rerr_invalid crt (Newpkt d dip)   = True"
  "d dip sip.            rerr_invalid crt (Pkt d dip sip)  = True"
  unfolding rerr_invalid_def by simp_all

definition
  initmissing :: "(nat  state option) × 'a  (nat  state) × 'a"
where
  "initmissing σ = (λi. case (fst σ) i of None  aodv_init i | Some s  s, snd σ)"

lemma not_in_net_ips_fst_init_missing [simp]:
  assumes "i  net_ips σ"
    shows "fst (initmissing (netgmap fst σ)) i = aodv_init i"
  using assms unfolding initmissing_def by simp

lemma fst_initmissing_netgmap_pair_fst [simp]:
  "fst (initmissing (netgmap (λ(p, q). (fst (id p), snd (id p), q)) s))
                                               = fst (initmissing (netgmap fst s))"
  unfolding initmissing_def by auto

text ‹We introduce a streamlined alternative to @{term initmissing} with @{term netgmap}
        to simplify invariant statements and thus facilitate their comprehension and
        presentation.›

lemma fst_initmissing_netgmap_default_aodv_init_netlift:
  "fst (initmissing (netgmap fst s)) = default aodv_init (netlift fst s)"
  unfolding initmissing_def default_def
  by (simp add: fst_netgmap_netlift del: One_nat_def)

definition
  netglobal :: "((nat  state)  bool)  ((state × 'b) × 'c) net_state  bool"
where
  "netglobal P  (λs. P (default aodv_init (netlift fst s)))"

end

Theory E_Fresher

(*  Title:       variants/e_all_abcd/Fresher.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Quality relations between routes"

theory E_Fresher
imports E_Aodv_Data
begin

subsection "Net sequence numbers"

subsubsection "On individual routes"

definition
  nsqnr :: "r  sqn"
where
  "nsqnr r  if π4(r) = val  π2(r) = 0 then π2(r) else (π2(r) - 1)"

lemma nsqnr_def':
  "nsqnr r = (if π4(r) = inv then π2(r) - 1 else π2(r))"
  unfolding nsqnr_def by simp

lemma nsqnr_zero [simp]:
  "dsn dsk flag hops nhip. nsqnr (0, dsk, flag, hops, nhip) = 0"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_val [simp]:
  "dsn dsk hops nhip. nsqnr (dsn, dsk, val, hops, nhip) = dsn"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_inv [simp]:
  "dsn dsk hops nhip. nsqnr (dsn, dsk, inv, hops, nhip) = dsn - 1"
  unfolding nsqnr_def by clarsimp

lemma nsqnr_lte_dsn [simp]:
  "dsn dsk flag hops nhip. nsqnr (dsn, dsk, flag, hops, nhip)  dsn"
  unfolding nsqnr_def by clarsimp

subsubsection "On routes in routing tables"

definition
  nsqn :: "rt  ip  sqn"
where
  "nsqn  λrt dip. case σroute(rt, dip) of None  0 | Some r  nsqnr(r)"

lemma nsqn_sqn_def:
  "rt dip. nsqn rt dip = (if flag rt dip = Some val  sqn rt dip = 0
                            then sqn rt dip else sqn rt dip - 1)"
  unfolding nsqn_def sqn_def by (clarsimp split: option.split)

lemma not_in_kD_nsqn [simp]:
  assumes "dip  kD(rt)"
  shows "nsqn rt dip = 0"
  using assms unfolding nsqn_def by simp

lemma kD_nsqn:
  assumes "dip  kD(rt)"
    shows "nsqn rt dip = nsqnr(the (σroute(rt, dip)))"
  using assms [THEN kD_Some] unfolding nsqn_def by clarsimp

lemma nsqnr_r_flag_pred [simp, intro]:
    fixes dsn dsk flag hops nhip pre
  assumes "P (nsqnr (dsn, dsk, val, hops, nhip))"
      and "P (nsqnr (dsn, dsk, inv, hops, nhip))"
    shows "P (nsqnr (dsn, dsk, flag, hops, nhip))"
  using assms by (cases flag) auto

lemma sqn_nsqn:
  "rt dip. sqn rt dip - 1  nsqn rt dip"
  unfolding sqn_def nsqn_def by (clarsimp split: option.split)

lemma nsqn_sqn: "nsqn rt dip  sqn rt dip"
  unfolding sqn_def nsqn_def by (cases "rt dip") auto

lemma val_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = val"
    shows "nsqn rt ip = sqn rt ip"
  using assms unfolding nsqn_sqn_def by auto

lemma vD_nsqn_sqn [elim, simp]:
  assumes "ipvD(rt)"
    shows "nsqn rt ip = sqn rt ip"
  proof -
    from ipvD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = val" by auto
    thus ?thesis ..
  qed

lemma inv_nsqn_sqn [elim, simp]:
  assumes "ipkD(rt)"
      and "the (flag rt ip) = inv"
    shows "nsqn rt ip = sqn rt ip - 1"
  using assms unfolding nsqn_sqn_def by auto

lemma iD_nsqn_sqn [elim, simp]:
  assumes "ipiD(rt)"
    shows "nsqn rt ip = sqn rt ip - 1"
  proof -
    from ipiD(rt) have "ipkD(rt)"
                      and "the (flag rt ip) = inv" by auto
    thus ?thesis ..
  qed

lemma nsqn_update_changed_kno_val [simp]: "rt ip dsn dsk hops nhip.
  rt  update rt ip (dsn, kno, val, hops, nhip)
    nsqn (update rt ip (dsn, kno, val, hops, nhip)) ip = dsn"
  unfolding nsqnr_def update_def
  by (clarsimp simp: kD_nsqn split: option.split_asm option.split if_split_asm)
     (metis fun_upd_triv)

lemma nsqn_update_other [simp]:
    fixes dsn dsk flag hops dip nhip pre rt ip
  assumes "dip  ip"
    shows "nsqn (update rt ip (dsn, dsk, flag, hops, nhip)) dip = nsqn rt dip"
    using assms unfolding nsqn_def
    by (clarsimp split: option.split)

lemma nsqn_invalidate_eq:
  assumes "dip  kD(rt)"
      and "dests dip = Some rsn"
    shows "nsqn (invalidate rt dests) dip = rsn - 1"
  using assms
  proof -
    from assms obtain dsk hops nhip
      where "invalidate rt dests dip = Some (rsn, dsk, inv, hops, nhip)"
      unfolding invalidate_def
      by auto
    moreover from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp
    ultimately show ?thesis
      using dests dip = Some rsn by simp
  qed

lemma nsqn_invalidate_other [simp]:
  assumes "dipkD(rt)"
      and "dipdom dests"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  using assms by (clarsimp simp add: kD_nsqn)

subsection "Comparing routes "

definition
  fresher :: "r  r  bool" ("(_/  _)"  [51, 51] 50)
where
  "fresher r r'  ((nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r')))"

lemma fresherI1 [intro]:
  assumes "nsqnr r < nsqnr r'"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI2 [intro]:
  assumes "nsqnr r = nsqnr r'"
      and "π5(r)  π5(r')"
    shows "r  r'"
  unfolding fresher_def using assms by simp

lemma fresherI [intro]:
  assumes "(nsqnr r < nsqnr r')  (nsqnr r  = nsqnr r'  π5(r)  π5(r'))"
    shows "r  r'"
  unfolding fresher_def using assms .

lemma fresherE [elim]:
  assumes "r  r'"
      and "nsqnr r < nsqnr r'  P r r'"
      and "nsqnr r  = nsqnr r'  π5(r)  π5(r')  P r r'"
    shows "P r r'"
  using assms unfolding fresher_def by auto

lemma fresher_refl [simp]: "r  r"
  unfolding fresher_def by simp

lemma fresher_trans [elim, trans]:
  " x  y; y  z   x  z"
  unfolding fresher_def by auto

lemma not_fresher_trans [elim, trans]:
  " ¬(x  y); ¬(z  x)   ¬(z  y)"
  unfolding fresher_def by auto

lemma fresher_dsn_flag_hops_const [simp]:
  fixes dsn dsk dsk' flag hops nhip nhip'
   shows "(dsn, dsk, flag, hops, nhip)  (dsn, dsk', flag, hops, nhip')"
  unfolding fresher_def by (cases flag) simp_all

subsection "Comparing routing tables "

definition
  rt_fresher :: "ip  rt  rt  bool"
where
  "rt_fresher  λdip rt rt'. (the (σroute(rt, dip)))  (the (σroute(rt', dip)))"

abbreviation
   rt_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊑⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresher i rt1 rt2"

lemma rt_fresher_def':
  "(rt1i rt2) = (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i)) 
                     nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5 (the (rt2 i))  π5 (the (rt1 i)))"
  unfolding rt_fresher_def fresher_def by (rule refl)

lemma single_rt_fresher [intro]:
  assumes "the (rt1 ip)  the (rt2 ip)"
    shows "rt1ip rt2"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_single [intro]:
  assumes "rt1ip rt2"
    shows "the (rt1 ip)  the (rt2 ip)"
  using assms unfolding rt_fresher_def .

lemma rt_fresher_def2:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
    shows "(rt1dip rt2) = (nsqn rt1 dip < nsqn rt2 dip
                                (nsqn rt1 dip = nsqn rt2 dip
                                    the (dhops rt1 dip)  the (dhops rt2 dip)))"
  using assms unfolding rt_fresher_def fresher_def by (simp add: kD_nsqn proj5_eq_dhops)

lemma rt_fresherI1 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3) by simp

lemma rt_fresherI2 [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip = nsqn rt2 dip"
      and "the (dhops rt1 dip)  the (dhops rt2 dip)"
    shows "rt1dip rt2"
  unfolding rt_fresher_def2 [OF assms(1-2)] using assms(3-4) by simp

lemma rt_fresherE [elim]:
  assumes "rt1dip rt2"
      and "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and " nsqn rt1 dip < nsqn rt2 dip   P rt1 rt2 dip"
      and " nsqn rt1 dip = nsqn rt2 dip;
             the (dhops rt1 dip)  the (dhops rt2 dip)   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms(1) unfolding rt_fresher_def2 [OF assms(2-3)]
  using assms(4-5) by auto

lemma rt_fresher_refl [simp]: "rtdip rt"
  unfolding rt_fresher_def by simp

lemma rt_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms unfolding rt_fresher_def by auto

lemma rt_fresher_if_Some [intro!]:
  assumes "the (rt dip)  r"
    shows "rtdip (λip. if ip = dip then Some r else rt ip)"
  using assms unfolding rt_fresher_def by simp

definition rt_fresh_as :: "ip  rt  rt  bool"
where
  "rt_fresh_as  λdip rt1 rt2. (rt1dip rt2)  (rt2dip rt1)"

abbreviation
   rt_fresh_as_syn :: "rt  ip  rt  bool" ("(_/ ≈⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_fresh_as i rt1 rt2"

lemma rt_fresh_as_refl [simp]: "rt dip. rtdip rt"
  unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_trans [simp, intro, trans]:
  "rt1 rt2 rt3 dip.  rt1dip rt2; rt2dip rt3   rt1dip rt3"
  unfolding rt_fresh_as_def rt_fresher_def
  by (metis (mono_tags) fresher_trans)

lemma rt_fresh_asI [intro!]:
  assumes "rt1dip rt2"
      and "rt2dip rt1"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_fresherI [intro]:
  assumes "dipkD(rt1)"
      and "dipkD(rt2)"
      and "the (rt1 dip)  the (rt2 dip)"
      and "the (rt2 dip)  the (rt1 dip)"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def
  by (clarsimp dest!: single_rt_fresher)

lemma nsqn_rt_fresh_asI:
  assumes "dip  kD(rt)"
      and "dip  kD(rt')"
      and "nsqn rt dip = nsqn rt' dip"
      and "π5(the (rt dip)) = π5(the (rt' dip))"
    shows "rtdip rt'"
  proof
    from assms(1-2,4) have dhops': "the (dhops rt' dip)  the (dhops rt dip)"
      by (simp add: proj5_eq_dhops)
    with assms(1-3) show "rtdip rt'"
      by (rule rt_fresherI2)
  next
    from assms(1-2,4) have dhops: "the (dhops rt dip)  the (dhops rt' dip)"
      by (simp add: proj5_eq_dhops)
    with assms(2,1) assms(3) [symmetric] show "rt'dip rt"
      by (rule rt_fresherI2)
  qed

lemma rt_fresh_asE [elim]:
  assumes "rt1dip rt2"
      and " rt1dip rt2; rt2dip rt1   P rt1 rt2 dip"
    shows "P rt1 rt2 dip"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD1 [dest]:
  assumes "rt1dip rt2"
    shows "rt1dip rt2"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_asD2 [dest]:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma rt_fresh_as_sym:
  assumes "rt1dip rt2"
    shows "rt2dip rt1"
  using assms unfolding rt_fresh_as_def by simp

lemma not_rt_fresh_asI1 [intro]:
  assumes "¬ (rt1dip rt2)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt1dip rt2" ..
    with ¬ (rt1dip rt2) show False ..
  qed

lemma not_rt_fresh_asI2 [intro]:
  assumes "¬ (rt2dip rt1)"
    shows "¬ (rt1dip rt2)"
  proof
    assume "rt1dip rt2"
    hence "rt2dip rt1" ..
    with ¬ (rt2dip rt1) show False ..
  qed

lemma not_single_rt_fresher [elim]:
  assumes "¬(the (rt1 ip)  the (rt2 ip))"
    shows "¬(rt1ip rt2)"
  proof
    assume "rt1ip rt2"
    hence "the (rt1 ip)  the (rt2 ip)" ..
    with ¬(the (rt1 ip)  the (rt2 ip)) show False ..
  qed

lemmas not_single_rt_fresh_asI1 [intro] =  not_rt_fresh_asI1 [OF not_single_rt_fresher]
lemmas not_single_rt_fresh_asI2 [intro] =  not_rt_fresh_asI2 [OF not_single_rt_fresher]

lemma not_rt_fresher_single [elim]:
  assumes "¬(rt1ip rt2)"
    shows "¬(the (rt1 ip)  the (rt2 ip))"
  proof
    assume "the (rt1 ip)  the (rt2 ip)"
    hence "rt1ip rt2" ..
    with ¬(rt1ip rt2) show False ..
  qed

lemma rt_fresh_as_nsqnr:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "rt1dip rt2"
    shows "nsqnr (the (rt2 dip)) = nsqnr (the (rt1 dip))"
  using assms(3) unfolding rt_fresh_as_def
  by (auto simp: rt_fresher_def2 [OF dip  kD(rt1) dip  kD(rt2)]
                 rt_fresher_def2 [OF dip  kD(rt2) dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt1)]
                 kD_nsqn [OF dip  kD(rt2)])

lemma rt_fresher_mapupd [intro!]:
  assumes "dipkD(rt)"
      and "the (rt dip)  r"
    shows "rtdip rt(dip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_map_update_other [intro!]:
  assumes "dipkD(rt)"
      and "dip  ip"
    shows "rtdip rt(ip  r)"
  using assms unfolding rt_fresher_def by simp

lemma rt_fresher_update_other [simp]:
  assumes inkD: "dipkD(rt)"
     and "dip  ip"
   shows "rtdip update rt ip r"
   using assms unfolding update_def
   by (clarsimp split: option.split) (fastforce)

theorem rt_fresher_update [simp]:
  assumes "dipkD(rt)"
      and "the (dhops rt dip)  1"
      and "update_arg_wf r"
   shows "rtdip update rt ip r"
  proof (cases "dip = ip")
    assume "dip  ip" with dipkD(rt) show ?thesis
      by (rule rt_fresher_update_other)
  next
    assume "dip = ip"

    from dipkD(rt) obtain dsnn dskn fn hopsn nhipn
      where rtn [simp]: "the (rt dip) = (dsnn, dskn, fn, hopsn, nhipn)"
      by (metis prod_cases5)
    with ‹the (dhops rt dip)  1 and dipkD(rt) have "hopsn  1"
      by (metis proj5_eq_dhops projs(4))
    from dipkD(rt) rtn have [simp]: "sqn rt dip = dsnn"
                           and [simp]: "the (dhops rt dip) = hopsn"
                           and [simp]: "the (flag rt dip) = fn"
      by (simp add: sqn_def proj5_eq_dhops [symmetric]
                            proj4_eq_flag [symmetric])+

    from ‹update_arg_wf r have "(dsnn, dskn, fn, hopsn, nhipn)
                                   the ((update rt dip r) dip)"
      proof (rule wf_r_cases)
        fix nhip
        from hopsn  1 have "(dsnn, dskn, fn, hopsn, nhipn)
                                         (dsnn, unk, val, Suc 0, nhip)"
          unfolding fresher_def sqn_def by (cases fn) auto
        thus "(dsnn, dskn, fn, hopsn, nhipn)
                the (update rt dip (0, unk, val, Suc 0, nhip) dip)"
          using dipkD(rt) by - (rule update_cases_kD, simp_all)
      next
        fix dsn :: sqn and hops nhip
        assume "0 < dsn"
        show "(dsnn, dskn, fn, hopsn, nhipn)
                the (update rt dip (dsn, kno, val, hops, nhip) dip)"
        proof (rule update_cases_kD [OF _ dipkD(rt)], simp_all add: 0 < dsn)
          assume "dsnn < dsn"
            thus "(dsnn, dskn, fn, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def by auto
        next
          assume "dsnn = dsn"
             and "hops < hopsn"
            thus "(dsn, dskn, fn, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def nsqnr_def by simp
        next
          assume "dsnn = dsn"
            with 0 < dsn
            show "(dsn, dskn, inv, hopsn, nhipn)
                    (dsn, kno, val, hops, nhip)"
              unfolding fresher_def by simp
        qed
      qed
    hence "rtdip update rt dip r"
      by - (rule single_rt_fresher, simp)
    with dip = ip show ?thesis by simp
  qed

theorem rt_fresher_invalidate [simp]:
  assumes "dipkD(rt)"
      and indests: "ripdom(dests). ripvD(rt)  sqn rt rip < the (dests rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
      thus ?thesis using dipkD(rt)
      by - (rule single_rt_fresher, simp)
  next
    assume "dipdom(dests)"
    moreover with indests have "dipvD(rt)"
                           and "sqn rt dip < the (dests dip)"
      by auto
    ultimately show ?thesis
      unfolding invalidate_def sqn_def
      by - (rule single_rt_fresher, auto simp: fresher_def)
  qed

lemma nsqnr_invalidate [simp]:
  assumes "dipkD(rt)"
      and "dipdom(dests)"
    shows "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
  using assms unfolding invalidate_def by auto

lemma rt_fresh_as_inc_invalidate [simp]:
  assumes "dipkD(rt)"
      and "ripdom(dests). ripvD(rt)  the (dests rip) = inc (sqn rt rip)"
    shows "rtdip invalidate rt dests"
  proof (cases "dipdom(dests)")
    assume "dipdom(dests)"
    with dipkD(rt) have "dipkD(invalidate rt dests)"
      by simp
    with dipkD(rt) show ?thesis
      by rule (simp_all add: dipdom(dests))
  next
    assume "dipdom(dests)"
    with assms(2) have "dipvD(rt)"
                  and "the (dests dip) = inc (sqn rt dip)" by auto
    from dipvD(rt) have "dipkD(rt)" by simp
    moreover then have "dipkD(invalidate rt dests)" by simp
    ultimately show ?thesis
    proof (rule nsqn_rt_fresh_asI)
      from dipvD(rt) have "nsqn rt dip = sqn rt dip" by simp
      also have "sqn rt dip = nsqnr (the (invalidate rt dests dip))"
      proof -
        from dipkD(rt) have "nsqnr (the (invalidate rt dests dip)) = the (dests dip) - 1"
          using dipdom(dests) by (rule nsqnr_invalidate)
        with ‹the (dests dip) = inc (sqn rt dip)
          show "sqn rt dip = nsqnr (the (invalidate rt dests dip))" by simp
      qed
      also from dipkD(invalidate rt dests)
        have "nsqnr (the (invalidate rt dests dip)) = nsqn (invalidate rt dests) dip"
          by (simp add: kD_nsqn)
      finally show "nsqn rt dip = nsqn (invalidate rt dests) dip" .
    qed simp
  qed

lemmas rt_fresher_inc_invalidate [simp] = rt_fresh_as_inc_invalidate [THEN rt_fresh_asD1]


subsection "Strictly comparing routing tables "

definition rt_strictly_fresher :: "ip  rt  rt  bool"
where
  "rt_strictly_fresher  λdip rt1 rt2. (rt1dip rt2)  ¬(rt1dip rt2)"

abbreviation
   rt_strictly_fresher_syn :: "rt  ip  rt  bool" ("(_/ ⊏⇘_ _)"  [51, 999, 51] 50)
where
  "rt1i rt2  rt_strictly_fresher i rt1 rt2"

lemma rt_strictly_fresher_def'':
  "rt1i rt2 = ((rt1i rt2)  ¬(rt2i rt1))"
  unfolding rt_strictly_fresher_def rt_fresh_as_def by auto

lemma rt_strictly_fresherI' [intro]:
  assumes "rt1i rt2"
      and "¬(rt2i rt1)"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherE' [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt2i rt1)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms unfolding rt_strictly_fresher_def'' by simp

lemma rt_strictly_fresherI [intro]:
  assumes "rt1i rt2"
      and "¬(rt1i rt2)"
    shows "rt1i rt2"
  unfolding rt_strictly_fresher_def using assms ..

lemmas rt_strictly_fresher_singleI [elim] = rt_strictly_fresherI [OF single_rt_fresher]

lemma rt_strictly_fresherE [elim]:
  assumes "rt1i rt2"
      and " rt1i rt2; ¬(rt1i rt2)   P rt1 rt2 i"
    shows "P rt1 rt2 i"
  using assms(1) unfolding rt_strictly_fresher_def
  by rule (erule(1) assms(2))

lemma rt_strictly_fresher_def':
  "rt1i rt2 =
     (nsqnr (the (rt1 i)) < nsqnr (the (rt2 i))
        (nsqnr (the (rt1 i)) = nsqnr (the (rt2 i))  π5(the (rt1 i)) > π5(the (rt2 i))))"
  unfolding rt_strictly_fresher_def'' rt_fresher_def fresher_def by auto

lemma rt_strictly_fresher_fresherD [dest]:
  assumes "rt1dip rt2"
    shows "the (rt1 dip)  the (rt2 dip)"
  using assms unfolding rt_strictly_fresher_def rt_fresher_def by auto

lemma rt_strictly_fresher_not_fresh_asD [dest]:
  assumes "rt1dip rt2"
    shows "¬ rt1dip rt2"
  using assms unfolding rt_strictly_fresher_def by auto

lemma rt_strictly_fresher_trans [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  using assms proof -
    from rt1dip rt2 obtain "the (rt1 dip)  the (rt2 dip)" by auto
    also from rt2dip rt3 obtain "the (rt2 dip)  the (rt3 dip)" by auto
    finally have "the (rt1 dip)  the (rt3 dip)" .

    moreover have "¬ (rt1dip rt3)"
    proof -    
      from rt1dip rt2 obtain "¬(the (rt2 dip)  the (rt1 dip))" by auto
      also from rt2dip rt3 obtain "¬(the (rt3 dip)  the (rt2 dip))" by auto
      finally have "¬(the (rt3 dip)  the (rt1 dip))" .
      thus ?thesis ..
    qed
    ultimately show "rt1dip rt3" ..
 qed

lemma rt_strictly_fresher_irefl [simp]: "¬ (rtdip rt)"
  unfolding rt_strictly_fresher_def
  by clarsimp

lemma rt_fresher_trans_rt_strictly_fresher [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt1dip rt2 have "rt1dip rt2"
                           and "¬(rt2dip rt1)"
      unfolding rt_strictly_fresher_def'' by auto
    from this(1) and rt2dip rt3 have "rt1dip rt3" ..

    moreover from ¬(rt2dip rt1) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        with rt2dip rt3 show "rt2dip rt1" ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_trans_rt_strictly_fresher' [elim, trans]:
  assumes "rt1dip rt2"
      and "rt2dip rt3"
    shows "rt1dip rt3"
  proof -
    from rt2dip rt3 have "rt2dip rt3"
                           and "¬(rt3dip rt2)"
      unfolding rt_strictly_fresher_def'' by auto
    from rt1dip rt2 and this(1) have "rt1dip rt3" ..

    moreover from ¬(rt3dip rt2) have "¬(rt3dip rt1)"
      proof (rule contrapos_nn)
        assume "rt3dip rt1"
        thus "rt3dip rt2" using rt1dip rt2 ..
      qed

    ultimately show "rt1dip rt3"
      unfolding rt_strictly_fresher_def'' by auto
  qed

lemma rt_fresher_imp_nsqn_le:
  assumes "rt1ip rt2"
      and "ip  kD rt1"
      and "ip  kD rt2"
    shows "nsqn rt1 ip  nsqn rt2 ip"
  using assms(1)
  by (auto simp add: rt_fresher_def2 [OF assms(2-3)])

lemma rt_strictly_fresher_ltI [intro]:
  assumes "dip  kD(rt1)"
      and "dip  kD(rt2)"
      and "nsqn rt1 dip < nsqn rt2 dip"
    shows "rt1dip rt2"
  proof
    from assms show "rt1dip rt2" ..
  next
    show "¬(rt1dip rt2)"
    proof
      assume "rt1dip rt2"
      hence "rt2dip rt1" ..
      hence "nsqn rt2 dip  nsqn rt1 dip"
        using dip  kD(rt2) dip  kD(rt1)
        by (rule rt_fresher_imp_nsqn_le)
      with ‹nsqn rt1 dip < nsqn rt2 dip show "False"
        by simp
    qed
  qed

lemma rt_strictly_fresher_eqI [intro]:
  assumes "ikD(rt1)"
      and "ikD(rt2)"
      and "nsqn rt1 i = nsqn rt2 i"
      and "π5(the (rt2 i)) < π5(the (rt1 i))"
    shows "rt1i rt2"
  using assms unfolding rt_strictly_fresher_def' by (auto simp add: kD_nsqn)

lemma invalidate_rtsf_left [simp]:
  "dests dip rt rt'. dests dip = None  (invalidate rt destsdip rt') = (rtdip rt')"
  unfolding invalidate_def rt_strictly_fresher_def'
  by (rule iffI) (auto split: option.split_asm)

lemma vD_invalidate_rt_strictly_fresher [simp]:
  assumes "dip  vD(invalidate rt1 dests)"
    shows "(invalidate rt1 destsdip rt2) = (rt1dip rt2)"
  proof (cases "dip  dom(dests)")
    assume "dip  dom(dests)"
    hence "dip  vD(invalidate rt1 dests)"
      unfolding invalidate_def vD_def
      by clarsimp (metis assms option.simps(3) vD_invalidate_vD_not_dests)
    with dip  vD(invalidate rt1 dests) show ?thesis by simp
  next
    assume "dip  dom(dests)"
    hence "dests dip = None" by auto
    moreover with dip  vD(invalidate rt1 dests) have "dip  vD(rt1)"
      unfolding invalidate_def vD_def
      by clarsimp (metis (hide_lams, no_types) assms vD_Some vD_invalidate_vD_not_dests)
    ultimately show ?thesis
      unfolding invalidate_def rt_strictly_fresher_def' by auto
  qed

lemma rt_strictly_fresher_update_other [elim!]:
  "dip ip rt r rt'.  dip  ip; rtdip rt'   update rt ip rdip rt'"
  unfolding rt_strictly_fresher_def' by clarsimp

lemma lt_sqn_imp_update_strictly_fresher:
  assumes "dip  vD (rt2 nhip)"
      and  *: "osn < sqn (rt2 nhip) dip"
      and **: "rt  update rt dip (osn, kno, val, hops, nhip)"
    shows "update rt dip (osn, kno, val, hops, nhip)dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI1)
    from ** have "nsqn (update rt dip (osn, kno, val, hops, nhip)) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, hops, nhip) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn < sqn (rt2 nhip) dip" by (rule *)
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD (rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, hops, nhip) dip))
                                                              < nsqnr (the (rt2 nhip dip))" .
  qed

lemma dhops_le_hops_imp_update_strictly_fresher:
  assumes "dip  vD(rt2 nhip)"
      and sqn: "sqn (rt2 nhip) dip = osn"
      and hop: "the (dhops (rt2 nhip) dip)  hops"
      and **: "rt  update rt dip (osn, kno, val, Suc hops, nhip)"
    shows "update rt dip (osn, kno, val, Suc hops, nhip)dip rt2 nhip"
  unfolding rt_strictly_fresher_def'
  proof (rule disjI2, rule conjI)
    from ** have "nsqn (update rt dip (osn, kno, val, Suc hops, nhip)) dip = osn"
      by (rule nsqn_update_changed_kno_val)
    with dipvD(rt2 nhip)
      have "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip) dip)) = osn"
        by (simp add: kD_nsqn)
    also have "osn = sqn (rt2 nhip) dip" by (rule sqn [symmetric])
    also have "sqn (rt2 nhip) dip = nsqnr (the (rt2 nhip dip))"
      unfolding nsqnr_def using dip  vD(rt2 nhip)
      by - (metis vD_flag_val proj2_eq_sqn proj4_eq_flag vD_iD_gives_kD(1))
    finally show "nsqnr (the (update rt dip (osn, kno, val, Suc hops, nhip) dip))
                                                              = nsqnr (the (rt2 nhip dip))" .
  next
    have "the (dhops (rt2 nhip) dip)  hops" by (rule hop)
    also have "hops < hops + 1" by simp
    also have "hops + 1 = the (dhops (update rt dip (osn, kno, val, Suc hops, nhip)) dip)"
      using ** by simp
    finally have "the (dhops (rt2 nhip) dip)
                        < the (dhops (update rt dip (osn, kno, val, Suc hops, nhip)) dip)" .
    thus "π5 (the (rt2 nhip dip)) < π5 (the (update rt dip (osn, kno, val, Suc hops, nhip) dip))"
      using dip  vD(rt2 nhip) by (simp add: proj5_eq_dhops)
  qed

lemma nsqn_invalidate:
  assumes "dip  kD(rt)"
      and "ipdom(dests). ip  vD(rt)  the (dests ip) = inc (sqn rt ip)"
    shows "nsqn (invalidate rt dests) dip = nsqn rt dip"
  proof -
    from dip  kD(rt) have "dip  kD(invalidate rt dests)" by simp

    from assms have "rtdip invalidate rt dests"
      by (rule rt_fresh_as_inc_invalidate)
    with dip  kD(rt) dip  kD(invalidate rt dests) show ?thesis
      by (simp add: kD_nsqn del: invalidate_kD_inv)
         (erule(2) rt_fresh_as_nsqnr)
  qed

end

Theory E_Seq_Invariants

(*  Title:       variants/e_all_abcd/Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Invariant proofs on individual processes"

theory E_Seq_Invariants
imports AWN.Invariants E_Aodv E_Aodv_Data E_Aodv_Predicates E_Fresher
begin

text ‹
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
›

text ‹Proposition 7.2›

lemma sequence_number_increases:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i  onl ΓAODV (λ(ξ, _). 1  sn ξ)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: σAODV_def)

text ‹We can get rid of the onl/onll if desired...›

lemma sequence_number_increases':
  "paodv i A (λ((ξ, _), _, (ξ', _)). sn ξ  sn ξ')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i  (λ(ξ, _). 1  sn ξ)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i  onl ΓAODV (λ(ξ, l). l  ({PAodv-:7}  {PAodv-:5}  {PRrep-:0..PRrep-:4}
                                      {PRreq-:0..PRreq-:3})  sip ξ  kD (rt ξ))"
  by inv_cterms

text ‹Proposition 7.38›

lemma includes_nhip:
  "paodv i  onl ΓAODV (λ(ξ, l). dipkD(rt ξ). the (nhop (rt ξ) dip)kD(rt ξ))"
  proof -
    { fix ip and ξ ξ' :: state
      assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
         and "ξ' = ξrt := update (rt ξ) ip (0, unk, val, Suc 0, ip)"
      hence "dipkD (rt ξ).
               the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip)) dip) = ip
              the (nhop (update (rt ξ) ip (0, unk, val, Suc 0, ip)) dip)  kD (rt ξ)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and ξ ξ' :: state
       assume "dipkD (rt ξ). the (nhop (rt ξ) dip)  kD (rt ξ)"
          and "ξ' = ξrt := update (rt ξ) ip (sn, kno, val, Suc hops, sip)"
          and "sip  kD (rt ξ)"
       hence "(the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) ip) = ip
                  the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) ip)  kD (rt ξ))
                (dipkD (rt ξ).
                    the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) dip) = ip
                     the (nhop (update (rt ξ) ip (sn, kno, val, Suc hops, sip)) dip)  kD (rt ξ))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                       solve: one_hop nhip_is_sip)
  qed

text ‹Proposition 7.4›

lemma known_destinations_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ'))"
  by (inv_cterms simp add: subset_insertI)

text ‹Proposition 7.5›

lemma rreqs_increase:
  "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). rreqs ξ  rreqs ξ')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i  onl ΓAODV (λ(ξ, l). l  {PAodv-:15..PAodv-:17}
                                  {PPkt-:7..PPkt-:9}
                                  {PRreq-:11..PRreq-:13}
                                  {PRreq-:20..PRreq-:22}
                                  {PRrep-:7..PRrep-:9}
                                  {PRerr-:1..PRerr-:4}  {PRerr-:6}
                          (ipdom(dests ξ). ipkD(rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)))"
  proof -
    have sqninv:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         sqn (invalidate rt dests) ip  rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "dests rt rsn ip.
        ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip); dests ip = Some rsn 
         ipkD(rt)  sqn rt ip  rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text ‹Proposition 7.6›

lemma sqns_increase:
   "paodv i A onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip)"
  proof -
    { fix ξ :: state
      assume *: "ipdom(dests ξ). ip  kD (rt ξ)  sqn (rt ξ) ip  the (dests ξ ip)"
      have "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
      proof
        fix ip
        from * have "ipdom(dests ξ)  sqn (rt ξ) ip  the (dests ξ ip)" by simp
        thus "sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text ‹Proposition 7.7›

lemma ip_constant:
  "paodv i  onl ΓAODV (λ(ξ, _). ip ξ = i)"
  by (inv_cterms simp add: σAODV_def)

text ‹Proposition 7.8›

lemma sender_ip_valid':
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = ip ξ) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i  (recvmsg P →) onl ΓAODV (λ(ξ, l). l  {PAodv-:1}  P (msg ξ))"
  by inv_cterms

text ‹Proposition 7.9›

lemma sip_not_ip':
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  ip ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i  (recvmsg (λm. not_Pkt m  msg_sender m  i) →) onl ΓAODV (λ(ξ, _). sip ξ  i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text ‹Neither sip_not_ip'› nor sip_not_ip› is needed to show loop freedom.›

text ‹Proposition 7.10›

lemma hop_count_positive:
  "paodv i  onl ΓAODV (λ(ξ, _). ipkD (rt ξ). the (dhops (rt ξ) ip)  1)"
  by (inv_cterms) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:16..PRreq-:17}  dip ξ  vD(rt ξ))
                             (l  {PRreq-:6, PRreq-:7}  dip ξ = ip ξ)
                             (l  {PRreq-:15..PRreq-:17}  dip ξ  ip ξ))"
  by inv_cterms

lemma rrep_dip_in_vD:
  "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRrep-:4}  dip ξ  vD(rt ξ)))"
  by inv_cterms

text ‹Proposition 7.11›

lemma anycast_msg_zhops:
  "rreqid dip dsn dsk oip osn sip.
      paodv i A onll ΓAODV (λ(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
           onl_invariant_sterms [OF aodv_wf rrep_dip_in_vD]
           onl_invariant_sterms [OF aodv_wf hop_count_positive],
         elim conjE)
    fix l ξ a pp p' pp'
    assume "(ξ, pp)  reachable (paodv i) TT"
       and "{PRreq-:16}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
               λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp"
       and "l = PRreq-:16"
       and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
       and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "0 < the (dhops (rt ξ) (dip ξ))" by simp
  next
    fix l ξ a pp p' pp'    
    assume "(ξ, pp)  reachable (paodv i) TT"
      and "{PRrep-:4}unicast(λξ. the (nhop (rt ξ) (oip ξ)),
              λξ. Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ)).
                     p'  pp'  sterms ΓAODV pp" 
      and "l = PRrep-:4"
      and "a = unicast (the (nhop (rt ξ) (oip ξ)))
                 (Rrep (the (dhops (rt ξ) (dip ξ))) (dip ξ) (sqn (rt ξ) (dip ξ)) (oip ξ) (ip ξ))"
      and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
      and "dip ξ  vD (rt ξ)"
    from ‹dip ξ  vD (rt ξ) have "dip ξ  kD (rt ξ)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0  the (dhops (rt ξ) (dip ξ))" ..
    thus "the (dhops (rt ξ) (dip ξ)) = 0  dip ξ = ip ξ"
      by auto
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i  (recvmsg msg_zhops →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:4, PAodv-:5}  {PRreq-:n|n. True}  1  osn ξ)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →)  onl ΓAODV (λ(ξ, l).
                                    l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, l).
                 (l{PAodv-:4..PAodv-:5}  {PRreq-:n|n. True} 
                          (hops ξ = 0  oip ξ = sip ξ))
                 
                 ((l{PAodv-:6..PAodv-:7}  {PRrep-:n|n. True} 
                          (hops ξ = 0  dip ξ = sip ξ))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (λm. rreq_rrep_sn m  msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text ‹Proposition 7.12›

lemma zero_seq_unk_hops_one':
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  sqnf (rt ξ) dip = unk)
                               (sqnf (rt ξ) dip = unk  the (dhops (rt ξ) dip) = 1)
                               (the (dhops (rt ξ) dip) = 1  the (nhop (rt ξ) dip) = dip))"
  proof -
  { fix dip and ξ :: state and P
    assume "sqn (invalidate (rt ξ) (dests ξ)) dip = 0"
       and all: "ip. sqn (rt ξ) ip  sqn (invalidate (rt ξ) (dests ξ)) ip"
       and *: "sqn (rt ξ) dip = 0  P ξ dip"
    have "P ξ dip"
    proof -
      from all have "sqn (rt ξ) dip  sqn (invalidate (rt ξ) (dests ξ)) dip" ..
      with ‹sqn (invalidate (rt ξ) (dests ξ)) dip = 0 have "sqn (rt ξ) dip = 0" by simp
      thus "P ξ dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "hops = 0  sip = dip"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = Suc 0 
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "π3(the (update rt dip (dsn, kno, val, Suc hops, sip) ip)) = unk 
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip)) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "dipkD(rt).
                (sqn rt dip = 0  π3(the (rt dip)) = unk) 
                (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
                (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
       and "Suc 0  dsn"
       and "ip  dip  ipkD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip)) ip = 0 
           π3 (the (update rt dip (dsn, kno, val, Suc hops, sip) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "dipkD rt.
              (sqn rt dip = 0  π3(the (rt dip)) = unk) 
              (π3(the (rt dip)) = unk  the (dhops rt dip) = Suc 0) 
              (the (dhops rt dip) = Suc 0  the (nhop rt dip) = dip)"
    hence "dipkD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip)) dip = 0 
           π3(the (update rt sip (0, unk, val, Suc 0, sip) dip)) = unk)
         (π3(the (update rt sip (0, unk, val, Suc 0, sip) dip)) = unk 
           the (dhops (update rt sip (0, unk, val, Suc 0, sip)) dip) = Suc 0)
         (the (dhops (update rt sip (0, unk, val, Suc 0, sip)) dip) = Suc 0 
           the (nhop (update rt sip (0, unk, val, Suc 0, sip)) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "sip rt.
    π3(the (update rt sip (0, unk, val, Suc 0, sip) sip)) = unk 
    the (dhops (update rt sip (0, unk, val, Suc 0, sip)) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip)) sip = 0 
    π3 (the (update rt sip (0, unk, val, Suc 0, sip) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i  (recvmsg (λm. rreq_rrep_sn m  msg_zhops m) →) onl ΓAODV (λ(ξ, _).
                 dipkD(rt ξ). (sqn (rt ξ) dip = 0  (sqnf (rt ξ) dip = unk
                                                          the (dhops (rt ξ) dip) = 1
                                                          the (nhop (rt ξ) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                               dipkD(rt ξ). π3(the (rt ξ dip)) = unk  1  π2(the (rt ξ dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2
      assume "dsk1 = unk  Suc 0  dsn2"
      hence "π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1) sip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2
      assume allkd: "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn rt dip"
         and    **: "dsk1 = unk  Suc 0  dsn2"
      have "dipkD(rt). π3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1) dip)) = unk
             Suc 0  sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2)) dip"
        (is "dipkD(rt). ?prop dip")
      proof
        fix dip
        assume "dipkD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip  sip"
          with dipkD(rt) allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "ipdom(dests). ipkD(rt)  sqn rt ip  the (dests ip)"
         and **: "ipkD(rt). π3(the (rt ip)) = unk  Suc 0  sqn rt ip"
      have "dipkD(rt). π3(the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dipkD(rt)"
        with ** have "π3(the (rt dip)) = unk  Suc 0  sqn rt dip" ..
        thus "π3 (the (rt dip)) = unk  Suc 0  sqn (invalidate rt dests) dip"
        proof
          assume "π3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0  sqn rt dip"
          have "Suc 0  sqn (invalidate rt dests) dip"
          proof (cases "dipdom(dests)")
            assume "dipdom(dests)"
            with * have "sqn rt dip  the (dests dip)" by simp
            with ‹Suc 0  sqn rt dip have "Suc 0  the (dests dip)" by simp
            with dipdom(dests) dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dipdom(dests)"
            with ‹Suc 0  sqn rt dip dipkD(rt) [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text ‹Proposition 7.13›

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    (* due to lack of addpreRT_welldefined, sqnf_know needed some small adaption [adding dip ξ ∈ kD (rt ξ)] *)
    have sqnf_kno: "paodv i  onl ΓAODV (λ(ξ, l).
                                      (l  {PRreq-:16}  dip ξ  kD (rt ξ)  sqnf (rt ξ) (dip ξ) = kno))"
      by (inv_cterms)

    have rrep_sqn_greater_dsn: "paodv i  (recvmsg rreq_rrep_sn →) onl ΓAODV (λ(ξ, l).
                                      (l  {PRrep-:1 .. PRrep-:4}  1  sqn (rt ξ) (dip ξ)))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (clarsimp simp: update_kno_dsn_greater_zero [simplified])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                              onl_invariant_sterms [OF aodv_wf rrep_sqn_greater_dsn])
         (auto simp: proj2_eq_sqn)
  qed

text ‹Proposition 7.14›

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a)"
  proof -                                                      
    have rreq_oip: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:3..PRreq-:9}  {PRreq-:15, PRreq-:24, PRreq-:26}
                                oip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val))))"
      proof inv_cterms
        fix l ξ l' pp p'
        assume "(ξ, pp)  reachable (paodv i) TT"
           and "{PRreq-:2}λξ. ξrt :=
                update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ) p'  sterms ΓAODV pp"
           and "l' = PRreq-:3"
        show "osn ξ < sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ)
            (sqn (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ) = osn ξ
              the (dhops (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ))
                                                                             Suc (hops ξ)
              the (flag (update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)) (oip ξ))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i  onl ΓAODV (λ(ξ, l).
          (l  {PRrep-:4}  (dip ξ  kD(rt ξ)
                                         the (flag (rt ξ) (dip ξ)) = val)))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]) 

    have rreq_oip_kD: "paodv i  onl ΓAODV (λ(ξ, l). (l  {PRreq-:3..PRreq-:22}  oip ξ  kD(rt ξ)))"
      by(inv_cterms) 

    have rreq_dip_kD_oip_sqn: "paodv i  onl ΓAODV (λ(ξ, l).
                       (l  {PRreq-:16..PRreq-:17}
                               (dip ξ  kD(rt ξ)
                                  (sqn (rt ξ) (oip ξ) > (osn ξ)
                                      (sqn (rt ξ) (oip ξ) = (osn ξ)
                                         the (dhops (rt ξ) (oip ξ))  Suc (hops ξ)
                                         the (flag (rt ξ) (oip ξ)) = val)))))"
      by(inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep]
                              onl_invariant_sterms [OF aodv_wf rreq_oip_kD]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_kD_oip_sqn])
  qed

text ‹Proposition 7.15›

lemma rerr_invalid_any_step_invariant:
  "paodv i A onll ΓAODV (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a)"
  proof -
    have dests_inv: "paodv i 
                      onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:11,
                                            PRreq-:20, PRrep-:7, PRerr-:1}
                           (ipdom(dests ξ). ipvD(rt ξ)))
                          (l  {PAodv-:16..PAodv-:17}
                               {PPkt-:8..PPkt-:9}
                               {PRreq-:12..PRreq-:13}
                               {PRreq-:21..PRreq-:22}
                               {PRrep-:8..PRrep-:9}
                               {PRerr-:2..PRerr-:4}  (ipdom(dests ξ). ipiD(rt ξ)
                                                           the (dests ξ ip) = sqn (rt ξ) ip))
                          (l = PPkt-:12  dip ξiD(rt ξ)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text ‹Proposition 7.16›

text ‹
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip  sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
›

lemma dests_vD_inc_sqn:
  "paodv i 
        onl ΓAODV (λ(ξ, l). (l  {PAodv-:15, PPkt-:7, PRreq-:11, PRreq-:20, PRrep-:7}
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) = inc (sqn (rt ξ) ip)))
            (l = PRerr-:1
              (ipdom(dests ξ). ipvD(rt ξ)  the (dests ξ ip) > sqn (rt ξ) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text ‹Proposition 7.27›

lemma route_tables_fresher:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)).
                                                                dipkD(rt ξ). rt ξdip rt ξ')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf invariant_restrict_inD])
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}λξ. ξrt := update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)
               p'  sterms ΓAODV pp"
       and "Suc 0  osn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  osn ξ
        have "update_arg_wf (osn ξ, kno, val, Suc (hops ξ), sip ξ)" ..
      ultimately show "rt ξip update (rt ξ) (oip ξ) (osn ξ, kno, val, Suc (hops ξ), sip ξ)"
        by (rule rt_fresher_update)
    qed
  next
    fix ξ pp p'
    assume "(ξ, pp)  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:0}λξ. ξrt := update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)
            p'  sterms ΓAODV pp"
       and "Suc 0  dsn ξ"
       and *: "ipkD (rt ξ). Suc 0  the (dhops (rt ξ) ip)"
    show "ipkD (rt ξ). rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)"
    proof
      fix ip
      assume "ipkD (rt ξ)"
      moreover with * have "1  the (dhops (rt ξ) ip)" by simp
      moreover from ‹Suc 0  dsn ξ
        have "update_arg_wf (dsn ξ, kno, val, Suc (hops ξ), sip ξ)" ..
      ultimately show "rt ξip update (rt ξ) (dip ξ) (dsn ξ, kno, val, Suc (hops ξ), sip ξ)"
        by (rule rt_fresher_update)
    qed
  qed

end

Theory E_Quality_Increases

(*  Title:       variants/e_all_abcd/Quality_Increases.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "The quality increases predicate"

theory E_Quality_Increases
imports E_Aodv_Predicates E_Fresher
begin

definition quality_increases :: "state  state  bool"
where "quality_increases ξ ξ'  (dipkD(rt ξ). dip  kD(rt ξ')  rt ξdip rt ξ')
                                                (dip. sqn (rt ξ) dip  sqn (rt ξ') dip)"

lemma quality_increasesI [intro!]:
  assumes "dip. dip  kD(rt ξ)  dip  kD(rt ξ')"
      and "dip.  dip  kD(rt ξ); dip  kD(rt ξ')   rt ξdip rt ξ'"          
      and "dip. sqn (rt ξ) dip  sqn (rt ξ') dip"
    shows "quality_increases ξ ξ'"
  unfolding quality_increases_def using assms by clarsimp

lemma quality_increasesE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "dipkD(rt ξ)"
      and " dip  kD(rt ξ'); rt ξdip rt ξ'; sqn (rt ξ) dip  sqn (rt ξ') dip   R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_rt_fresherD [dest]:
    fixes ip
  assumes "quality_increases ξ ξ'"
      and "ipkD(rt ξ)"
    shows "rt ξip rt ξ'"
  using assms by auto

lemma quality_increases_sqnE [elim]:
    fixes dip
  assumes "quality_increases ξ ξ'"
      and "sqn (rt ξ) dip  sqn (rt ξ') dip  R dip ξ ξ'"
    shows "R dip ξ ξ'"
  using assms unfolding quality_increases_def by clarsimp

lemma quality_increases_refl [intro, simp]: "quality_increases ξ ξ"
  by rule simp_all

lemma strictly_fresher_quality_increases_right [elim]:
    fixes σ σ' dip
  assumes "rt (σ i)dip rt (σ nhip)"                       
      and qinc: "quality_increases (σ nhip) (σ' nhip)"
      and "dipkD(rt (σ nhip))"
    shows "rt (σ i)dip rt (σ' nhip)"
  proof -
    from qinc have "rt (σ nhip)dip rt (σ' nhip)" using dipkD(rt (σ nhip))
      by auto
    with ‹rt (σ i)dip rt (σ nhip) show ?thesis ..
  qed

lemma kD_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')"
  using assms by auto

lemma kD_nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  nsqn (rt ξ) i  nsqn (rt ξ') i"
  proof -
    from assms have "ikD(rt ξ')" ..
    moreover with assms have "rt ξi rt ξ'" by auto
    ultimately have "nsqn (rt ξ) i  nsqn (rt ξ') i"
      using ikD(rt ξ) by - (erule(2) rt_fresher_imp_nsqn_le)
    with ikD(rt ξ') show ?thesis ..
  qed

lemma nsqn_quality_increases [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
    shows "nsqn (rt ξ) i  nsqn (rt ξ') i"
  using assms by (rule kD_nsqn_quality_increases [THEN conjunct2])

lemma kD_nsqn_quality_increases_trans [elim]:
  assumes "ikD(rt ξ)"
      and "s  nsqn (rt ξ) i"
      and "quality_increases ξ ξ'"
    shows "ikD(rt ξ')  s  nsqn (rt ξ') i"
  proof
    from ikD(rt ξ) and ‹quality_increases ξ ξ' show "ikD(rt ξ')" ..
  next
    from ikD(rt ξ) and ‹quality_increases ξ ξ' have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s  nsqn (rt ξ) i show "s  nsqn (rt ξ') i" by (rule le_trans)
  qed

lemma nsqn_quality_increases_nsqn_lt_lt [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
     and "s < nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i"
  proof -
    from assms(1-2) have "nsqn (rt ξ) i  nsqn (rt ξ') i" ..
    with s < nsqn (rt ξ) i show "s < nsqn (rt ξ') i" by simp
  qed

lemma nsqn_quality_increases_dhops [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "nsqn (rt ξ) i = nsqn (rt ξ') i"
    shows "the (dhops (rt ξ) i)  the (dhops (rt ξ') i)"
  using assms unfolding quality_increases_def
  by (clarsimp) (drule(1) bspec, clarsimp simp: rt_fresher_def2)

lemma nsqn_quality_increases_nsqn_eq_le [elim]:
  assumes "ikD(rt ξ)"
      and "quality_increases ξ ξ'"
      and "s = nsqn (rt ξ) i"
    shows "s < nsqn (rt ξ') i  (s = nsqn (rt ξ') i  the (dhops (rt ξ) i)  the (dhops (rt ξ') i))"
  using assms by (metis nat_less_le nsqn_quality_increases nsqn_quality_increases_dhops)

lemma quality_increases_rreq_rrep_props [elim]:
    fixes sn ip hops sip
  assumes qinc: "quality_increases (σ sip) (σ' sip)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
      (is "_  ?nsqnafter")
  proof -
    from *  obtain "ipkD(rt (σ sip))" and "sn  nsqn (rt (σ sip)) ip" by auto

    from ‹quality_increases (σ sip) (σ' sip)
       have "sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip" ..
    from ‹quality_increases (σ sip) (σ' sip) and ipkD (rt (σ sip))
      have "ipkD (rt (σ' sip))" ..

    from sn  nsqn (rt (σ sip)) ip have ?nsqnafter
    proof
      assume "sn < nsqn (rt (σ sip)) ip"
      also from ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "...  nsqn (rt (σ' sip)) ip" ..
      finally have "sn < nsqn (rt (σ' sip)) ip" .
      thus ?thesis by simp
    next
      assume "sn = nsqn (rt (σ sip)) ip"
      with ipkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
        have "sn < nsqn (rt (σ' sip)) ip
               (sn = nsqn (rt (σ' sip)) ip
                  the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip))" ..
      hence "sn < nsqn (rt (σ' sip)) ip
               (nsqn (rt (σ' sip)) ip = sn  (the (dhops (rt (σ' sip)) ip)  hops
                                                  the (flag (rt (σ' sip)) ip) = inv))"
      proof
        assume "sn < nsqn (rt (σ' sip)) ip" thus ?thesis ..
      next
        assume "sn = nsqn (rt (σ' sip)) ip
                 the (dhops (rt (σ sip)) ip)  the (dhops (rt (σ' sip)) ip)"
        hence "sn = nsqn (rt (σ' sip)) ip"
          and "the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)" by auto

        from * and sn = nsqn (rt (σ sip)) ip have "the (dhops (rt (σ sip)) ip)  hops
                                                        the (flag (rt (σ sip)) ip) = inv"
          by simp
        thus ?thesis
        proof
          assume "the (dhops (rt (σ sip)) ip)  hops"
          with  ‹the (dhops (rt (σ' sip)) ip)  the (dhops (rt (σ sip)) ip)
           have "the (dhops (rt (σ' sip)) ip)  hops" by simp
          with sn = nsqn (rt (σ' sip)) ip show ?thesis by simp
        next
          assume "the (flag (rt (σ sip)) ip) = inv"
          with ipkD(rt (σ sip)) have "nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1" ..

          with sn  1 and sn = nsqn (rt (σ sip)) ip
            have "sqn (rt (σ sip)) ip > 1" by simp

          from ipkD(rt (σ' sip)) show ?thesis
          proof (rule vD_or_iD)
            assume "ipiD(rt (σ' sip))"
            hence "the (flag (rt (σ' sip)) ip) = inv" ..
            with sn = nsqn (rt (σ' sip)) ip show ?thesis
              by simp
          next
            (* the tricky case: sn = nsqn (rt (σ' sip)) ip
                                ∧ ip∈iD(rt (σ sip))
                                ∧ ip∈vD(rt (σ' sip)) *)
            assume "ipvD(rt (σ' sip))"
            hence "nsqn (rt (σ' sip)) ip = sqn (rt (σ' sip)) ip" ..
            with ‹sqn (rt (σ sip)) ip  sqn (rt (σ' sip)) ip
              have "nsqn (rt (σ' sip)) ip  sqn (rt (σ sip)) ip" by simp

            with ‹sqn (rt (σ sip)) ip > 1
              have "nsqn (rt (σ' sip)) ip > sqn (rt (σ sip)) ip - 1" by simp
            with ‹nsqn (rt (σ sip)) ip = sqn (rt (σ sip)) ip - 1
              have "nsqn (rt (σ' sip)) ip > nsqn (rt (σ sip)) ip" by simp
            with sn = nsqn (rt (σ sip)) ip have "nsqn (rt (σ' sip)) ip > sn"
              by simp
            thus ?thesis ..
          qed
        qed
      qed
      thus ?thesis by (metis (mono_tags) le_cases not_le)
    qed
    with ipkD (rt (σ' sip)) show "ipkD (rt (σ' sip))  ?nsqnafter" ..
  qed

lemma quality_increases_rreq_rrep_props':
    fixes sn ip hops sip
  assumes "j. quality_increases (σ j) (σ' j)"
      and "1  sn"
      and *: "ipkD(rt (σ sip))  sn  nsqn (rt (σ sip)) ip
                                 (nsqn (rt (σ sip)) ip = sn
                                     (the (dhops (rt (σ sip)) ip)  hops
                                           the (flag (rt (σ sip)) ip) = inv))"
    shows "ipkD(rt (σ' sip))  sn  nsqn (rt (σ' sip)) ip
                               (nsqn (rt (σ' sip)) ip = sn
                                   (the (dhops (rt (σ' sip)) ip)  hops
                                         the (flag (rt (σ' sip)) ip) = inv))"
  proof -
    from assms(1) have "quality_increases (σ sip) (σ' sip)" ..
    thus ?thesis using assms(2-3) by (rule quality_increases_rreq_rrep_props)
  qed

lemma rteq_quality_increases:
  assumes "j. j  i  quality_increases (σ j) (σ' j)"
      and "rt (σ' i) = rt (σ i)"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by clarsimp (metis order_refl quality_increasesI rt_fresher_refl)

definition msg_fresh :: "(ip  state)  msg  bool"
where "msg_fresh σ m 
         case m of Rreq hopsc _ _ _ oipc osnc sipc _  osnc  1  (sipc  oipc 
                       oipckD(rt (σ sipc))  nsqn (rt (σ sipc)) oipc  osnc
                        (nsqn (rt (σ sipc)) oipc = osnc
                              (hopsc  the (dhops (rt (σ sipc)) oipc)
                                   the (flag (rt (σ sipc)) oipc) = inv)))
                   | Rrep hopsc dipc dsnc _ sipc  dsnc  1  (sipc  dipc 
                       dipckD(rt (σ sipc))  nsqn (rt (σ sipc)) dipc  dsnc
                        (nsqn (rt (σ sipc)) dipc = dsnc
                              (hopsc  the (dhops (rt (σ sipc)) dipc)
                                    the (flag (rt (σ sipc)) dipc) = inv)))
                   | Rerr destsc sipc  (ripcdom(destsc). (ripckD(rt (σ sipc))
                                          the (destsc ripc) - 1  nsqn (rt (σ sipc)) ripc))
                   | _  True"

lemma msg_fresh [simp]:
  "hops dip dsn dsk oip osn sip handled.
           msg_fresh σ (Rreq hops dip dsn dsk oip osn sip handled) =
                            (osn  1  (sip  oip  oipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) oip  osn
                                      (nsqn (rt (σ sip)) oip = osn
                                            (hops  the (dhops (rt (σ sip)) oip)
                                                 the (flag (rt (σ sip)) oip) = inv))))"
  "hops dip dsn oip sip. msg_fresh σ (Rrep hops dip dsn oip sip) =
                            (dsn  1  (sip  dip  dipkD(rt (σ sip))
                                      nsqn (rt (σ sip)) dip  dsn
                                      (nsqn (rt (σ sip)) dip = dsn
                                            (hops  the (dhops (rt (σ sip)) dip))
                                                  the (flag (rt (σ sip)) dip) = inv)))"
  "dests sip.            msg_fresh σ (Rerr dests sip) =
                            (ripcdom(dests). (ripckD(rt (σ sip))
                                      the (dests ripc) - 1  nsqn (rt (σ sip)) ripc))"
  "d dip.                msg_fresh σ (Newpkt d dip)   = True"
  "d dip sip.            msg_fresh σ (Pkt d dip sip)  = True"
  unfolding msg_fresh_def by simp_all

lemma msg_fresh_inc_sn [simp, elim]:
  "msg_fresh σ m  rreq_rrep_sn m"
  by (cases m) simp_all

lemma recv_msg_fresh_inc_sn [simp, elim]:
  "orecvmsg (msg_fresh) σ m  recvmsg rreq_rrep_sn m"
  by (cases m) simp_all

lemma rreq_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn dsk oip osn sip handled
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rreq hops dip dsn dsk oip osn sip handled)"
      and "rreq_rrep_sn (Rreq hops dip dsn dsk oip osn sip handled)"
  shows "msg_fresh σ (Rreq hops dip dsn dsk oip osn sip handled)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms(2) have "1  osn" by simp
    thus ?thesis
    unfolding msg_fresh_def
    proof (simp only: msg.case, intro conjI impI)
      assume "sip  oip"
      with assms(1) show "oip  kD(?rt)" by simp
    next
      assume "sip  oip"
         and "nsqn ?rt oip = osn"
      show "the (dhops ?rt oip)  hops  the (flag ?rt oip) = inv"
      proof (cases "oipvD(?rt)")
        assume "oipvD(?rt)"
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with ‹nsqn ?rt oip = osn have "sqn ?rt oip = osn" by simp
        with assms(1) and sip  oip have "the (dhops ?rt oip)  hops"
          by simp
        thus ?thesis ..
      next
        assume "oipvD(?rt)"
        moreover from assms(1) and sip  oip have "oipkD(?rt)" by simp
        ultimately have "oipiD(?rt)" by auto
        hence "the (flag ?rt oip) = inv" ..
        thus ?thesis ..
      qed
    next
      assume "sip  oip"
      with assms(1) have "osn  sqn ?rt oip" by auto
      thus "osn  nsqn (rt (σ sip)) oip"
      proof (rule nat_le_eq_or_lt)
        assume "osn < sqn ?rt oip"
        hence "osn  sqn ?rt oip - 1" by simp
        also have "...  nsqn ?rt oip" by (rule sqn_nsqn)
        finally show "osn  nsqn ?rt oip" .
      next
        assume "osn = sqn ?rt oip"
        with assms(1) and sip  oip have "oipkD(?rt)"
                                       and "the (flag ?rt oip) = val"
          by auto
        hence "nsqn ?rt oip = sqn ?rt oip" ..
        with osn = sqn ?rt oip have "nsqn ?rt oip = osn" by simp
        thus "osn  nsqn ?rt oip" by simp
      qed
    qed simp
  qed

lemma rrep_nsqn_is_fresh [simp]:
  fixes σ msg hops dip dsn oip sip
  assumes "rreq_rrep_fresh (rt (σ sip)) (Rrep hops dip dsn oip sip)"
      and "rreq_rrep_sn (Rrep hops dip dsn oip sip)"
  shows "msg_fresh σ (Rrep hops dip dsn oip sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have "sip  dip  dipkD(?rt)  sqn ?rt dip = dsn  the (flag ?rt dip) = val"
      by simp
    hence "sip  dip  dipkD(?rt)  nsqn ?rt dip  dsn"
    by clarsimp
    with assms show "msg_fresh σ ?msg"
      by clarsimp
  qed

lemma rerr_nsqn_is_fresh [simp]:
  fixes σ msg dests sip
  assumes "rerr_invalid (rt (σ sip)) (Rerr dests sip)"
  shows "msg_fresh σ (Rerr dests sip)"
        (is "msg_fresh σ ?msg")
  proof -
    let ?rt = "rt (σ sip)"
    from assms have *: "(ripdom(dests). (ripiD(rt (σ sip))
                                      the (dests rip) = sqn (rt (σ sip)) rip))"
      by clarsimp
    have "(ripdom(dests). (ripkD(rt (σ sip))
                                      the (dests rip) - 1  nsqn (rt (σ sip)) rip))"
    proof
      fix rip
      assume "rip  dom dests"
      with * have "ripiD(rt (σ sip))" and "the (dests rip) = sqn (rt (σ sip)) rip"
        by auto

      from this(2) have "the (dests rip) - 1 = sqn (rt (σ sip)) rip - 1" by simp
      also have "...  nsqn (rt (σ sip)) rip" by (rule sqn_nsqn)
      finally have "the (dests rip) - 1  nsqn (rt (σ sip)) rip" .

      with ripiD(rt (σ sip))
        show "ripkD(rt (σ sip))  the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by clarsimp
    qed
    thus "msg_fresh σ ?msg"
      by simp
  qed

lemma quality_increases_msg_fresh [elim]:
  assumes qinc: "j. quality_increases (σ j) (σ' j)"
      and "msg_fresh σ m"
    shows "msg_fresh σ' m"
  using assms(2)
  proof (cases m)
    fix hops dip dsn dsk oip osn sip handled
    assume [simp]: "m = Rreq hops dip dsn dsk oip osn sip handled"
       and "msg_fresh σ m"
    then have "osn  1" and "sip = oip  (oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                            (nsqn (rt (σ sip)) oip = osn
                                                  (the (dhops (rt (σ sip)) oip)  hops
                                                       the (flag (rt (σ sip)) oip) = inv)))"
      by auto
    from this(2) show ?thesis
    proof
      assume "sip = oip" with osn  1 show ?thesis by simp
    next
      assume "oipkD(rt (σ sip))  osn  nsqn (rt (σ sip)) oip
                                   (nsqn (rt (σ sip)) oip = osn
                                       (the (dhops (rt (σ sip)) oip)  hops
                                            the (flag (rt (σ sip)) oip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "oipkD(rt (σ' sip))  osn  nsqn (rt (σ' sip)) oip
                                            (nsqn (rt (σ' sip)) oip = osn
                                               (the (dhops (rt (σ' sip)) oip)  hops
                                                     the (flag (rt (σ' sip)) oip) = inv))"
       using osn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with osn  1 show "msg_fresh σ' m"
        by (clarsimp)
    qed
  next
    fix hops dip dsn oip sip
    assume [simp]: "m = Rrep hops dip dsn oip sip"
       and "msg_fresh σ m"
    then have "dsn  1" and "sip = dip  (dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                            (nsqn (rt (σ sip)) dip = dsn
                                                  (the (dhops (rt (σ sip)) dip)  hops
                                                       the (flag (rt (σ sip)) dip) = inv)))"
      by auto
    from this(2) show "?thesis"
    proof
      assume "sip = dip" with dsn  1 show ?thesis by simp
    next
      assume "dipkD(rt (σ sip))  dsn  nsqn (rt (σ sip)) dip
                                   (nsqn (rt (σ sip)) dip = dsn
                                       (the (dhops (rt (σ sip)) dip)  hops
                                            the (flag (rt (σ sip)) dip) = inv))"
      moreover from qinc have "quality_increases (σ sip) (σ' sip)" ..
      ultimately have "dipkD(rt (σ' sip))  dsn  nsqn (rt (σ' sip)) dip
                                            (nsqn (rt (σ' sip)) dip = dsn
                                               (the (dhops (rt (σ' sip)) dip)  hops
                                                     the (flag (rt (σ' sip)) dip) = inv))"
        using dsn  1 by (rule quality_increases_rreq_rrep_props [rotated 2])
      with dsn  1 show "msg_fresh σ' m"
        by clarsimp
    qed
  next
    fix dests sip
    assume [simp]: "m = Rerr dests sip"
       and "msg_fresh σ m"
    then have *: "ripdom(dests). ripkD(rt (σ sip))
                               the (dests rip) - 1  nsqn (rt (σ sip)) rip"
      by simp
    have "ripdom(dests). ripkD(rt (σ' sip))
                          the (dests rip) - 1  nsqn (rt (σ' sip)) rip"
      proof
        fix rip
        assume "ripdom(dests)"
        with * have "ripkD(rt (σ sip))" and "the (dests rip) - 1  nsqn (rt (σ sip)) rip"
          by - (drule(1) bspec, clarsimp)+
        moreover from qinc have "quality_increases (σ sip) (σ' sip)" by simp
        ultimately show "ripkD(rt (σ' sip))  the (dests rip) - 1  nsqn (rt (σ' sip)) rip" ..
      qed
    thus ?thesis by simp
  qed simp_all

end

Theory E_OAodv

(*  Title:       variants/e_all_abcd/OAodv.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "The `open' AODV model"

theory E_OAodv
imports E_Aodv AWN.OAWN_SOS_Labels AWN.OAWN_Convert
begin

text ‹Definitions for stating and proving global network properties over individual processes.›

definition σAODV' :: "((ip  state) × ((state, msg, pseqp, pseqp label) seqp)) set"
where "σAODV'  {(λi. aodv_init i, ΓAODV PAodv)}"

abbreviation opaodv
  :: "ip  ((ip  state) × (state, msg, pseqp, pseqp label) seqp, msg seq_action) automaton"
where
  "opaodv i   init = σAODV', trans = oseqp_sos ΓAODV i "

lemma initiali_aodv [intro!, simp]: "initiali i (init (opaodv i)) (init (paodv i))"
  unfolding σAODV_def σAODV'_def by rule simp_all

lemma oaodv_control_within [simp]: "control_within ΓAODV (init (opaodv i))"
  unfolding σAODV'_def by (rule control_withinI) (auto simp del: ΓAODV_simps)

lemma σAODV'_labels [simp]: "(σ, p)  σAODV'   labels ΓAODV p = {PAodv-:0}"
  unfolding σAODV'_def by simp

lemma oaodv_init_kD_empty [simp]:
  "(σ, p)  σAODV'  kD (rt (σ i)) = {}"
  unfolding σAODV'_def kD_def by simp

lemma oaodv_init_vD_empty [simp]:
  "(σ, p)  σAODV'  vD (rt (σ i)) = {}"
  unfolding σAODV'_def vD_def by simp

lemma oaodv_trans: "trans (opaodv i) = oseqp_sos ΓAODV i"
  by simp

declare
  oseq_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]
  oseq_step_invariant_ctermsI [OF aodv_wf oaodv_control_within aodv_simple_labels oaodv_trans, cterms_intros]

end

Theory E_Global_Invariants

(*  Title:       variants/e_all_abcd/Global_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Global invariant proofs over sequential processes"

theory E_Global_Invariants
imports E_Seq_Invariants
        E_Aodv_Predicates
        E_Fresher
        E_Quality_Increases
        AWN.OAWN_Convert
        E_OAodv
begin

lemma other_quality_increases [elim]:
  assumes "other quality_increases I σ σ'"
    shows "j. quality_increases (σ j) (σ' j)"
  using assms by (rule, clarsimp) (metis quality_increases_refl)

lemma weaken_otherwith [elim]:
    fixes m
  assumes *: "otherwith P I (orecvmsg Q) σ σ' a"
      and weakenP: "σ m. P σ m  P' σ m"
      and weakenQ: "σ m. Q σ m  Q' σ m"
    shows "otherwith P' I (orecvmsg Q') σ σ' a"
  proof
    fix j
    assume "jI"
    with * have "P (σ j) (σ' j)" by auto
    thus "P' (σ j) (σ' j)" by (rule weakenP)
  next
    from * have "orecvmsg Q σ a" by auto
    thus "orecvmsg Q' σ a"
      by rule (erule weakenQ)
  qed

lemma oreceived_msg_inv:
  assumes other: "σ σ' m.  P σ m; other Q {i} σ σ'   P σ' m"
      and local: "σ m. P σ m  P (σ(i := σ imsg := m)) m"
    shows "opaodv i  (otherwith Q {i} (orecvmsg P), other Q {i} →)
                       onl ΓAODV (λ(σ, l). l  {PAodv-:1}  P σ (msg (σ i)))"
  proof (inv_cterms, intro impI)
    fix σ σ' l
    assume "l = PAodv-:1  P σ (msg (σ i))"
       and "l = PAodv-:1"
       and "other Q {i} σ σ'"
    from this(1-2) have "P σ (msg (σ i))" ..
    hence "P σ' (msg (σ i))" using ‹other Q {i} σ σ'
      by (rule other)
    moreover from ‹other Q {i} σ σ' have "σ' i = σ i" ..
    ultimately show "P σ' (msg (σ' i))" by simp
  next
    fix σ σ' msg
    assume "otherwith Q {i} (orecvmsg P) σ σ' (receive msg)"
       and "σ' i = σ imsg := msg"
    from this(1) have "P σ msg"
                 and "j. ji  Q (σ j) (σ' j)" by auto
    from this(1) have "P (σ(i := σ imsg := msg)) msg" by (rule local)
    thus "P σ' msg"
    proof (rule other)
      from σ' i = σ imsg := msg and j. ji  Q (σ j) (σ' j)
        show "other Q {i} (σ(i := σ imsg := msg)) σ'"
          by - (rule otherI, auto)
    qed
  qed

text ‹(Equivalent to) Proposition 7.27›

lemma local_quality_increases:
  "paodv i A (recvmsg rreq_rrep_sn →) onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ')"
  proof (rule step_invariantI)
    fix s a s'
    assume sr: "s  reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and tr: "(s, a, s')  trans (paodv i)"
       and rm: "recvmsg rreq_rrep_sn a"
    from sr have srTT: "s  reachable (paodv i) TT" ..

    from route_tables_fresher sr tr rm
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). dipkD (rt ξ). rt ξdip rt ξ') (s, a, s')"
        by (rule step_invariantD)

    moreover from known_destinations_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). kD (rt ξ)  kD (rt ξ')) (s, a, s')"
        by (rule step_invariantD)

    moreover from sqns_increase srTT tr TT_True
      have "onll ΓAODV (λ((ξ, _), _, (ξ', _)). ip. sqn (rt ξ) ip  sqn (rt ξ') ip) (s, a, s')"
        by (rule step_invariantD)

     ultimately show "onll ΓAODV (λ((ξ, _), _, (ξ', _)). quality_increases ξ ξ') (s, a, s')"
       unfolding onll_def by auto
  qed

lemmas olocal_quality_increases =
   open_seq_step_invariant [OF local_quality_increases initiali_aodv oaodv_trans aodv_trans,
                            simplified seqll_onll_swap]

lemma oquality_increases:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  (is "_ A (?S, _ →) _")
  proof (rule onll_ostep_invariantI, simp)
    fix σ p l a σ' p' l'
    assume or: "(σ, p)  oreachable (opaodv i) ?S (other quality_increases {i})"
       and ll: "l  labels ΓAODV p"
       and "?S σ σ' a"
       and tr: "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and ll': "l'  labels ΓAODV p'"
    from this(1-3) have "orecvmsg (λ_. rreq_rrep_sn) σ a"
      by (auto dest!: oreachable_weakenE [where QS="act (recvmsg rreq_rrep_sn)"
                                            and QU="other quality_increases {i}"]
                      otherwith_actionD)
    with or have orw: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn))
                                                      (other quality_increases {i})"
      by - (erule oreachable_weakenE, auto)
    with tr ll ll' and ‹orecvmsg (λ_. rreq_rrep_sn) σ a have "quality_increases (σ i) (σ' i)"
      by - (drule onll_ostep_invariantD [OF olocal_quality_increases], auto simp: seqll_def)
    with ?S σ σ' a show "j. quality_increases (σ j) (σ' j)"
      by (auto dest!: otherwith_syncD)
  qed

lemma rreq_rrep_nsqn_fresh_any_step_invariant:
  "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a)"
  proof (rule ostep_invariantI, simp del: act_simp)
    fix σ p a σ' p'
    assume or: "(σ, p)  oreachable (opaodv i) (act (recvmsg rreq_rrep_sn)) (other A {i})"
       and "((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i"
       and recv: "act (recvmsg rreq_rrep_sn) σ σ' a"
    obtain l l' where "llabels ΓAODV p" and "l'labels ΓAODV p'"
      by (metis aodv_ex_label)
    from ((σ, p), a, (σ', p'))  oseqp_sos ΓAODV i
      have tr: "((σ, p), a, (σ', p'))  trans (opaodv i)" by simp

    have "anycast (rreq_rrep_fresh (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rreq_rrep_fresh_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rreq_rrep_fresh (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (rerr_invalid (rt (σ i))) a"
    proof -
      have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
                           onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))"
        by (rule ostep_invariant_weakenE [OF
              open_seq_step_invariant [OF rerr_invalid_any_step_invariant initiali_aodv,
                                       simplified seqll_onll_swap]]) auto
      hence "onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (rerr_invalid (rt ξ)) a))
                                                                     ((σ, p), a, (σ', p'))"
        using or tr recv by - (erule(4) ostep_invariantE)
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast rreq_rrep_sn a"
    proof -
      from or tr recv
        have "onll ΓAODV (seqll i (λ(_, a, _). anycast rreq_rrep_sn a)) ((σ, p), a, (σ', p'))"
          by (rule ostep_invariantE [OF
                open_seq_step_invariant [OF rreq_rrep_sn_any_step_invariant initiali_aodv
                                            oaodv_trans aodv_trans,
                                         simplified seqll_onll_swap]])
      thus ?thesis
        using llabels ΓAODV p and l'labels ΓAODV p' by auto
    qed

    moreover have "anycast (λm. not_Pkt m  msg_sender m = i) a"
      proof -
        have "opaodv i A (act (recvmsg rreq_rrep_sn), other A {i} →)
               onll ΓAODV (seqll i (λ((ξ, _), a, _). anycast (λm. not_Pkt m  msg_sender m = i) a))"
          by (rule ostep_invariant_weakenE [OF
                open_seq_step_invariant [OF sender_ip_valid initiali_aodv,
                                         simplified seqll_onll_swap]]) auto
        thus ?thesis using or tr recv llabels ΓAODV p and l'labels ΓAODV p'
          by - (drule(3) onll_ostep_invariantD, auto)
      qed

    ultimately have "anycast (msg_fresh σ) a"
      by (simp_all add: anycast_def
                   del: msg_fresh
                   split: seq_action.split_asm msg.split_asm) simp_all
    thus "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) ((σ, p), a, (σ', p'))"
      by auto
  qed

lemma oreceived_rreq_rrep_nsqn_fresh_inv:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l). l  {PAodv-:1}  msg_fresh σ (msg (σ i)))"
  proof (rule oreceived_msg_inv)
    fix σ σ' m
    assume *: "msg_fresh σ m"
       and "other quality_increases {i} σ σ'"
    from this(2) have "j. quality_increases (σ j) (σ' j)" ..
    thus "msg_fresh σ' m" using * ..
  next
    fix σ m
    assume "msg_fresh σ m"
    thus "msg_fresh (σ(i := σ imsg := m)) m"
    proof (cases m)
      fix dests sip
      assume "m = Rerr dests sip"
      with ‹msg_fresh σ m show ?thesis by auto
    qed auto
  qed

lemma oquality_increases_nsqn_fresh:
  "opaodv i A (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
                onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j))"
  by (rule ostep_invariant_weakenE [OF oquality_increases]) auto

lemma oosn_rreq:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
       onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:4, PAodv-:5}  {PRreq-:n |n. True}  1  osn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF osn_rreq initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rreq_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:4, PAodv-:5, PRreq-:0, PRreq-:2}  sip (σ i)  oip (σ i))
                     oip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (oip (σ i))  osn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
    proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh
                                                              aodv_wf oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf oosn_rreq]
                   simp add: seqlsimp
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:4  l = PAodv-:5  l = PRreq-:0  l = PRreq-:2)  sip (σ i)  oip (σ i)
              oip (σ i)  kD (rt (σ (sip (σ i))))
                  osn (σ i)  nsqn (rt (σ (sip (σ i)))) (oip (σ i))
                  (nsqn (rt (σ (sip (σ i)))) (oip (σ i)) = osn (σ i)
                     the (dhops (rt (σ (sip (σ i)))) (oip (σ i)))  hops (σ i)
                         the (flag (rt (σ (sip (σ i)))) (oip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:4  l=PAodv-:5  l=PRreq-:0  l=PRreq-:2)  sip (σ' i)  oip (σ' i)"
           (is "?labels  sip (σ' i)  oip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  oip (σ i)" by simp
    show "oip (σ' i)  kD (rt (σ' (sip (σ' i))))
           osn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (oip (σ' i)) = osn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (oip (σ' i)))  hops (σ' i)
                   the (flag (rt (σ' (sip (σ' i)))) (oip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  osn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF oosn_rreq]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "oip (σ' i)  kD (rt (σ (sip (σ i))))
               osn (σ' i)  nsqn (rt (σ (sip (σ i)))) (oip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (oip (σ' i)) = osn (σ' i)
                   the (dhops (rt (σ (sip (σ i)))) (oip (σ' i)))  hops (σ' i)
                        the (flag (rt (σ (sip (σ i)))) (oip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto elim!: quality_increases_rreq_rrep_props')

lemma odsn_rrep:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
      onl ΓAODV (seql i (λ(ξ, l). l  {PAodv-:6, PAodv-:7}  {PRrep-:n|n. True}  1  dsn ξ))"
  by (rule oinvariant_weakenE [OF open_seq_invariant [OF dsn_rrep initiali_aodv]])
     (auto simp: seql_onl_swap)

lemma rrep_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                   (l  {PAodv-:6, PAodv-:7, PRrep-:0, PRrep-:1}  sip (σ i)  dip (σ i))
                     dip (σ i)  kD(rt (σ (sip (σ i))))
                         nsqn (rt (σ (sip (σ i)))) (dip (σ i))  dsn (σ i)
                         (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                             (hops (σ i)  the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))
                                   the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)))"
    (is "_  (?S, ?U →) _")
  proof (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                            oaodv_trans]
                             onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                             onl_oinvariant_sterms [OF aodv_wf odsn_rrep]
                   simp del: One_nat_def, rule impI)
    fix σ σ' p l
    assume "(σ, p)  oreachable (opaodv i) ?S ?U"
       and "l  labels ΓAODV p"
       and pre:
           "(l = PAodv-:6  l = PAodv-:7  l = PRrep-:0  l = PRrep-:1)  sip (σ i)  dip (σ i)
            dip (σ i)  kD (rt (σ (sip (σ i))))
                dsn (σ i)  nsqn (rt (σ (sip (σ i)))) (dip (σ i))
                (nsqn (rt (σ (sip (σ i)))) (dip (σ i)) = dsn (σ i)
                   the (dhops (rt (σ (sip (σ i)))) (dip (σ i)))  hops (σ i)
                       the (flag (rt (σ (sip (σ i)))) (dip (σ i))) = inv)"
       and "other quality_increases {i} σ σ'"
       and hyp: "(l=PAodv-:6  l=PAodv-:7  l=PRrep-:0  l=PRrep-:1)  sip (σ' i)  dip (σ' i)"
           (is "?labels  sip (σ' i)  dip (σ' i)")
    from this(4) have "σ' i = σ i" ..
    with hyp have hyp': "?labels  sip (σ i)  dip (σ i)" by simp
    show "dip (σ' i)  kD (rt (σ' (sip (σ' i))))
           dsn (σ' i)  nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i))
           (nsqn (rt (σ' (sip (σ' i)))) (dip (σ' i)) = dsn (σ' i)
              the (dhops (rt (σ' (sip (σ' i)))) (dip (σ' i)))  hops (σ' i)
                  the (flag (rt (σ' (sip (σ' i)))) (dip (σ' i))) = inv)"
    proof (cases "sip (σ i) = i")
      assume "sip (σ i)  i"
      from ‹other quality_increases {i} σ σ'
        have "quality_increases (σ (sip (σ i))) (σ' (sip (σ' i)))"
          by (rule otherE)  (clarsimp simp: ‹sip (σ i)  i)
      moreover from (σ, p)  oreachable (opaodv i) ?S ?U l  labels ΓAODV p and hyp
        have "1  dsn (σ' i)"
          by (auto dest!: onl_oinvariant_weakenD [OF odsn_rrep]
                   simp add: seqlsimp σ' i = σ i)
      moreover from ‹sip (σ i)  i hyp' and pre
        have "dip (σ' i)  kD (rt (σ (sip (σ i))))
               dsn (σ' i)  nsqn (rt (σ (sip (σ i)))) (dip (σ' i))
               (nsqn (rt (σ (sip (σ i)))) (dip (σ' i)) = dsn (σ' i)
                  the (dhops (rt (σ (sip (σ i)))) (dip (σ' i)))  hops (σ' i)
                      the (flag (rt (σ (sip (σ i)))) (dip (σ' i))) = inv)"
        by (auto simp: σ' i = σ i)
      ultimately show ?thesis
        by (rule quality_increases_rreq_rrep_props)
    next
      assume "sip (σ i) = i" thus ?thesis
        using σ' i = σ i hyp and pre by auto
    qed
  qed (auto simp add: seqlsimp elim!: quality_increases_rreq_rrep_props')

lemma rerr_sip:
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →)
               onl ΓAODV (λ(σ, l).
                 l  {PAodv-:8, PAodv-:9, PRerr-:0, PRerr-:1}
                  (ripcdom(dests (σ i)). ripckD(rt (σ (sip (σ i)))) 
                        the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc))"
  (is "_  (?S, ?U →) _")
  proof -
    { fix dests rip sip rsn and σ σ' :: "ip  state"
      assume qinc: "j. quality_increases (σ j) (σ' j)"
         and *: "ripdom dests. rip  kD (rt (σ sip))
                                   the (dests rip) - 1  nsqn (rt (σ sip)) rip"
         and "dests rip = Some rsn"
      from this(3) have "ripdom dests" by auto
      with * and dests rip = Some rsn have "ripkD(rt (σ sip))"
                                         and "rsn - 1  nsqn (rt (σ sip)) rip"
        by (auto dest!: bspec)
      from qinc have "quality_increases (σ sip) (σ' sip)" ..
      have "rip  kD(rt (σ' sip))  rsn - 1  nsqn (rt (σ' sip)) rip"
      proof
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          show "rip  kD(rt (σ' sip))" ..
      next
        from ripkD(rt (σ sip)) and ‹quality_increases (σ sip) (σ' sip)
          have "nsqn (rt (σ sip)) rip  nsqn (rt (σ' sip)) rip" ..
        with rsn - 1  nsqn (rt (σ sip)) rip show "rsn - 1  nsqn (rt (σ' sip)) rip"
          by (rule le_trans)
      qed
    } note partial = this

    show ?thesis
      by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                             oaodv_trans]
                              onl_oinvariant_sterms [OF aodv_wf oreceived_rreq_rrep_nsqn_fresh_inv]
                              other_quality_increases other_localD
                    simp del: One_nat_def, intro conjI)
         (clarsimp simp del: One_nat_def split: if_split_asm option.split_asm, erule(2) partial)+
  qed

lemma prerr_guard: "paodv i 
                  onl ΓAODV (λ(ξ, l). (l = PRerr-:1
                       (ipdom(dests ξ). ipvD(rt ξ)
                                              the (nhop (rt ξ) ip) = sip ξ
                                              sqn (rt ξ) ip < the (dests ξ ip))))"
  by (inv_cterms) (clarsimp split: option.split_asm if_split_asm)

lemmas odests_vD_inc_sqn =
         open_seq_invariant [OF dests_vD_inc_sqn initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

lemmas oprerr_guard =
         open_seq_invariant [OF prerr_guard initiali_aodv oaodv_trans aodv_trans,
                             simplified seql_onl_swap,
                             THEN oinvariant_anyact]

text ‹Proposition 7.28›

lemma seq_compare_next_hop':
  "opaodv i  (otherwith quality_increases {i} (orecvmsg msg_fresh),
                other quality_increases {i} →) onl ΓAODV (λ(σ, _).
                   dip. let nhip = the (nhop (rt (σ i)) dip)
                         in dip  kD(rt (σ i))  nhip  dip 
                            dip  kD(rt (σ nhip))  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  (is "_  (?S, ?U →) _")
  proof -

  { fix nhop and σ σ' :: "ip  state"
    assume  pre: "dipkD(rt (σ i)). nhop dip  dip 
                    dipkD(rt (σ (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip 
                  dipkD(rt (σ' (nhop dip)))  nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre have "dipkD(rt (σ (nhop dip)))"
                and "nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
        by auto
      from qinc have qinc_nhop: "quality_increases (σ (nhop dip)) (σ' (nhop dip))" ..
      with dipkD(rt (σ (nhop dip))) have "dipkD (rt (σ' (nhop dip)))" ..

      moreover have "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof -
        from dipkD(rt (σ (nhop dip))) qinc_nhop
          have "nsqn (rt (σ (nhop dip))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip show ?thesis
          by simp
      qed

      ultimately show "dipkD(rt (σ' (nhop dip)))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic = this

  { fix nhop and σ σ' :: "ip  state"
    assume pre: "dipkD(rt (σ i)). nhop dip  dip  dipkD(rt (σ (nhop dip)))
                                              nsqn (rt (σ i)) dip  nsqn (rt (σ (nhop dip))) dip"
       and ndest: "ripcdom (dests (σ i)). ripc  kD (rt (σ (sip (σ i))))
                                    the (dests (σ i) ripc) - 1  nsqn (rt (σ (sip (σ i)))) ripc"
       and issip: "ipdom (dests (σ i)). nhop ip = sip (σ i)"
       and qinc: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)). nhop dip  dip  dip  kD (rt (σ' (nhop dip)))
                  nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
    proof (intro ballI impI)
      fix dip
      assume "dipkD(rt (σ i))"
         and "nhop dip  dip"
      with pre and qinc have "dipkD(rt (σ' (nhop dip)))"
                         and "nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip"
        by (auto dest!: basic)

      have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip"
      proof (cases "dipdom (dests (σ i))")
        assume "dipdom (dests (σ i))"
        with dipkD(rt (σ i)) obtain dsn where "dests (σ i) dip = Some dsn"
          by auto
        with dipkD(rt (σ i)) have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = dsn - 1"
           by (rule nsqn_invalidate_eq)
        moreover have "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
        proof -
          from ‹dests (σ i) dip = Some dsn have "the (dests (σ i) dip) = dsn" by simp
          with ndest and dipdom (dests (σ i)) have "dip  kD (rt (σ (sip (σ i))))"
                                                      "dsn - 1  nsqn (rt (σ (sip (σ i)))) dip"
            by auto
          moreover from issip and dipdom (dests (σ i)) have "nhop dip = sip (σ i)" ..
          ultimately have "dip  kD (rt (σ (nhop dip)))"
                      and "dsn - 1  nsqn (rt (σ (nhop dip))) dip" by auto
          with qinc show "dsn - 1  nsqn (rt (σ' (nhop dip))) dip"
            by simp (metis kD_nsqn_quality_increases_trans)
        qed
        ultimately show ?thesis by simp
      next
        assume "dip  dom (dests (σ i))"
        with dipkD(rt (σ i))
          have "nsqn (invalidate (rt (σ i)) (dests (σ i))) dip = nsqn (rt (σ i)) dip"
            by (rule nsqn_invalidate_other)
        with ‹nsqn (rt (σ i)) dip  nsqn (rt (σ' (nhop dip))) dip show ?thesis by simp
      qed
      with dipkD(rt (σ' (nhop dip)))
        show "dip  kD (rt (σ' (nhop dip)))
               nsqn (invalidate (rt (σ i)) (dests (σ i))) dip  nsqn (rt (σ' (nhop dip))) dip" ..
    qed
  } note basic_prerr = this

  { fix σ σ' :: "ip  state"
    assume a1: "dipkD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                 dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                     nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and a2: "j. quality_increases (σ j) (σ' j)"
    have "dipkD(rt (σ i)).
          the (nhop (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i))) dip)  dip 
          dipkD(rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                        (0, unk, val, Suc 0, sip (σ i)))
                                  dip)))) 
          nsqn (update (rt (σ i)) (sip (σ i)) (0, unk, val, Suc 0, sip (σ i))) dip
           nsqn (rt (σ' (the (nhop (update (rt (σ i)) (sip (σ i))
                                      (0, unk, val, Suc 0, sip (σ i)))
                                dip))))
             dip" (is "dipkD(rt (σ i)). ?P dip")
    proof
      fix dip
      assume "dipkD(rt (σ i))"
      with a1 and a2  
        have "the (nhop (rt (σ i)) dip)  dip  dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                         nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
           by - (drule(1) basic, auto)
      thus "?P dip" by (cases "dip = sip (σ i)") auto
    qed
  } note nhop_update_sip = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                  dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                      nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                              osn  nsqn (rt (σ sip)) oip
                              (nsqn (rt (σ sip)) oip = osn
                                 the (dhops (rt (σ sip)) oip)  hops
                                     the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "(the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) oip)  oip
            oipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip)) oip))))
                 nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) oip
                    nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                   (osn, kno, val, Suc hops, sip)) oip)))) oip)"
       (is "?nhop_not_oip  ?oip_in_kD  ?nsqn_le_nsqn")
     proof (rule, split update_rt_split_asm)
       assume "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
          and "the (nhop (rt (σ i)) oip)  oip"
       with pre' show "?oip_in_kD  ?nsqn_le_nsqn" by auto
     next
       assume rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
          and notoip: ?nhop_not_oip
       with * qinc have ?oip_in_kD
         by (clarsimp elim!: kD_quality_increases)
       moreover with * pre qinc rtnot notoip have ?nsqn_le_nsqn
        by simp (metis kD_nsqn_quality_increases_trans)
       ultimately show "?oip_in_kD  ?nsqn_le_nsqn" ..
     qed
  } note update1 = this

  { fix σ σ' oip sip osn hops
    assume pre: "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                   dipkD(rt (σ (the (nhop (rt (σ i)) dip))))
                       nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip"
       and qinc: "j. quality_increases (σ j) (σ' j)"
       and *: "sip  oip  oipkD(rt (σ sip))
                            osn  nsqn (rt (σ sip)) oip
                            (nsqn (rt (σ sip)) oip = osn
                               the (dhops (rt (σ sip)) oip)  hops
                                   the (flag (rt (σ sip)) oip) = inv)"
    from pre and qinc
      have pre': "dipkD (rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                    dipkD(rt (σ' (the (nhop (rt (σ i)) dip))))
                        nsqn (rt (σ i)) dip  nsqn (rt (σ' (the (nhop (rt (σ i)) dip)))) dip"
        by (rule basic)
    have "dipkD(rt (σ i)).
           the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip
            dipkD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip)) dip))))
                nsqn (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip
                   nsqn (rt (σ' (the (nhop (update (rt (σ i)) oip
                                                  (osn, kno, val, Suc hops, sip)) dip)))) dip"
       (is "dipkD(rt (σ i)). _  ?dip_in_kD dip  ?nsqn_le_nsqn dip")
     proof (intro ballI impI, split update_rt_split_asm)
       fix dip
       assume "dipkD(rt (σ i))"
          and "the (nhop (rt (σ i)) dip)  dip"
          and "rt (σ i) = update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
        with pre' show "?dip_in_kD dip  ?nsqn_le_nsqn dip" by simp
     next
       fix dip
       assume "dipkD(rt (σ i))"
          and notdip: "the (nhop (update (rt (σ i)) oip
                             (osn, kno, val, Suc hops, sip)) dip)  dip"
          and rtnot: "rt (σ i)  update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
       show "?dip_in_kD dip  ?nsqn_le_nsqn dip"
       proof (cases "dip = oip")
         assume "dip  oip"
         with pre' dipkD(rt (σ i)) notdip
           show ?thesis by clarsimp
       next
         assume "dip = oip"
         with rtnot qinc dipkD(rt (σ i)) notdip *
           have "?dip_in_kD dip"
            by simp (metis kD_quality_increases)
         moreover from dip = oip rtnot qinc dipkD(rt (σ i)) notdip *
           have "?nsqn_le_nsqn dip" by simp (metis kD_nsqn_quality_increases_trans)
         ultimately show ?thesis ..
       qed
     qed
  } note update2 = this

  have "opaodv i  (?S, ?U →) onl ΓAODV (λ(σ, _).
                   dip  kD(rt (σ i)). the (nhop (rt (σ i)) dip)  dip
                       dip  kD(rt (σ (the (nhop (rt (σ i)) dip))))
                           nsqn (rt (σ i)) dip  nsqn (rt (σ (the (nhop (rt (σ i)) dip)))) dip)"
    by (inv_cterms inv add: oseq_step_invariant_sterms [OF oquality_increases_nsqn_fresh aodv_wf
                                                           oaodv_trans]
                            onl_oinvariant_sterms [OF aodv_wf odests_vD_inc_sqn]
                            onl_oinvariant_sterms [OF aodv_wf oprerr_guard]
                            onl_oinvariant_sterms [OF aodv_wf rreq_sip]
                            onl_oinvariant_sterms [OF aodv_wf rrep_sip]
                            onl_oinvariant_sterms [OF aodv_wf rerr_sip]
                            other_quality_increases
                            other_localD
                      solve: basic basic_prerr
                      simp add: seqlsimp nsqn_invalidate nhop_update_sip
                      simp del: One_nat_def)
       (rule conjI, erule(2) update1, erule(2) update2)+

    thus ?thesis unfolding Let_def by auto
  qed

text ‹Proposition 7.30›

lemmas okD_unk_or_atleast_one =
         open_seq_invariant [OF kD_unk_or_atleast_one initiali_aodv,
                             simplified seql_onl_swap]

lemmas ozero_seq_unk_hops_one =
         open_seq_invariant [OF zero_seq_unk_hops_one initiali_aodv,
                             simplified seql_onl_swap]

lemma oreachable_fresh_okD_unk_or_atleast_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                       (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                              msg_zhops m)))
                       (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "π3(the (rt (σ i) dip)) = unk  1  π2(the (rt (σ i) dip))"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF okD_unk_or_atleast_one [OF oaodv_trans aodv_trans]],
            auto dest!: otherwith_actionD onlD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma oreachable_fresh_ozero_seq_unk_hops_one:
    fixes dip
  assumes "(σ, p)  oreachable (opaodv i)
                     (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                          msg_zhops m)))
                     (other quality_increases {i})"
      and "dipkD(rt (σ i))"
    shows "sqn (rt (σ i)) dip = 0 
             sqnf (rt (σ i)) dip = unk
              the (dhops (rt (σ i)) dip) = 1
              the (nhop (rt (σ i)) dip) = dip"
    (is "?P dip")
  proof -
    have "l. llabels ΓAODV p" by (metis aodv_ex_label)
    with assms(1) have "dipkD (rt (σ i)). ?P dip"
      by - (drule oinvariant_weakenD [OF ozero_seq_unk_hops_one [OF oaodv_trans aodv_trans]],
            auto dest!: onlD otherwith_actionD simp: seqlsimp)
    with dipkD(rt (σ i)) show ?thesis by simp
  qed

lemma seq_nhop_quality_increases':
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        onl ΓAODV (λ(σ, _). dip. let nhip = the (nhop (rt (σ i)) dip)
                                               in dip  vD (rt (σ i))  vD (rt (σ nhip))
                                                   nhip  dip
                                                   (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (?S i, _ →) _")
  proof -
    have weaken:
      "p I Q R P. p  (otherwith quality_increases I (orecvmsg Q), other quality_increases I →) P
        p  (otherwith ((=)) I (orecvmsg (λσ m. Q σ m  R σ m)), other quality_increases I →) P"
        by auto
    {
      fix i a and σ σ' :: "ip  state"
      assume a1: "dip. dipvD(rt (σ i))
                         dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                         (the (nhop (rt (σ i)) dip))  dip
                          rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(rt (σ i))
                   dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
                   (the (nhop (rt (σ i)) dip))  dip
                rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(rt (σ i))"
           and a3: "dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))"
           and a4: "(the (nhop (rt (σ i)) dip))  dip"
        from ow have "j. j  i  σ j = σ' j" by auto
        show "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
        proof (cases "(the (nhop (rt (σ i)) dip)) = i")
          assume "(the (nhop (rt (σ i)) dip)) = i"
          with dip  vD(rt (σ i)) have "dip  vD(rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with (the (nhop (rt (σ i)) dip)) = i have "rt (σ i)dip rt (σ i)" by simp
          hence False by simp
          thus ?thesis ..
        next
          assume "(the (nhop (rt (σ i)) dip))  i"
          with j. j  i  σ j = σ' j
            have *: "σ (the (nhop (rt (σ i)) dip)) = σ' (the (nhop (rt (σ i)) dip))" by simp
          with dipvD (rt (σ' (the (nhop (rt (σ i)) dip))))
            have "dipvD (rt (σ (the (nhop (rt (σ i)) dip))))" by simp
          with a1 a2 a4 have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))" by simp
          with * show ?thesis by simp
        qed
      qed
    } note basic = this

    { fix σ σ' a dip sip i
      assume a1: "dip. dipvD(rt (σ i))
                       dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                       the (nhop (rt (σ i)) dip)  dip
                       rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
      have "dip. dipvD(update (rt (σ i)) sip (0, unk, val, Suc 0, sip))
            dipvD(rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip))))
            the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip
            update (rt (σ i)) sip (0, unk, val, Suc 0, sip)dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD (update (rt (σ i)) sip (0, unk, val, Suc 0, sip))"
           and a3: "dipvD(rt (σ' (the (nhop
                         (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip))))"
           and a4: "the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip"
        show "update (rt (σ i)) sip (0, unk, val, Suc 0, sip)dip rt (σ' (the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)))"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ‹the (nhop (update (rt (σ i)) sip (0, unk, val, Suc 0, sip)) dip)  dip
          have False by simp
          thus ?thesis ..
        next
          assume [simp]: "dip  sip"
          from a2 have "dipvD(rt (σ i))  dip = sip"
            by (rule vD_update_val)
          with dip  sip have "dipvD(rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ' (the (nhop (rt (σ i)) dip))))" by simp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using a1 ow by - (drule(1) basic, simp)
          with dip  sip show ?thesis
            by - (erule rt_strictly_fresher_update_other, simp)
        qed
      qed
    } note update_0_unk = this

    { fix σ a σ' nhop
      assume pre: "dip. dipvD(rt (σ i))  dipvD(rt (σ (nhop dip)))  nhop dip  dip
                          rt (σ i)dip rt (σ (nhop dip))"
         and ow: "?S i σ σ' a"
      have "dip. dip  vD (invalidate (rt (σ i)) (dests (σ i)))
                   dip  vD (rt (σ' (nhop dip)))  nhop dip  dip
                   rt (σ i)dip rt (σ' (nhop dip))"
      proof clarify
        fix dip
        assume "dipvD(invalidate (rt (σ i)) (dests (σ i)))"
           and "dipvD(rt (σ' (nhop dip)))"
           and "nhop dip  dip"
        from this(1) have "dipvD (rt (σ i))"
          by (clarsimp dest!: vD_invalidate_vD_not_dests)
        moreover from ow have "j. j  i  σ j = σ' j" by auto
        ultimately have "rt (σ i)dip rt (σ (nhop dip))"
          using pre dip  vD (rt (σ' (nhop dip))) nhop dip  dip
          by metis
        with j. j  i  σ j = σ' j show  "rt (σ i)dip rt (σ' (nhop dip))"
          by (metis rt_strictly_fresher_irefl)
      qed
    } note invalidate = this

    { fix σ a σ' dip oip osn sip hops i
      assume pre: "dip. dip  vD (rt (σ i))
                        dip  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                        the (nhop (rt (σ i)) dip)  dip
                    rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
         and ow: "?S i σ σ' a"
         and "Suc 0  osn"
         and a6: "sip  oip  oip  kD (rt (σ sip))
                                  osn  nsqn (rt (σ sip)) oip
                                  (nsqn (rt (σ sip)) oip = osn
                                     the (dhops (rt (σ sip)) oip)  hops
                                          the (flag (rt (σ sip)) oip) = inv)"
         and after: "σ' i = σ irt := update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)"
      have "dip. dip  vD (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip))
                 dip  vD (rt (σ' (the (nhop (update (rt (σ i)) oip
                                      (osn, kno, val, Suc hops, sip)) dip))))
                 the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip
              update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)dip
                 rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)))"
      proof clarify
        fix dip
        assume a2: "dipvD(update (rt (σ i)) oip (osn, kno, val, Suc (hops), sip))"
           and a3: "dipvD(rt (σ' (the (nhop (update (rt (σ i)) oip
                                                        (osn, kno, val, Suc hops, sip)) dip))))"
           and a4: "the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)  dip"
        from ow have a5: "j. j  i  σ j = σ' j" by auto
        show "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)dip
              rt (σ' (the (nhop (update (rt (σ i)) oip (osn, kno, val, Suc hops, sip)) dip)))"
          (is "?rt1dip ?rt2 dip")
        proof (cases "?rt1 = rt (σ i)")
          assume nochange [simp]:
            "update (rt (σ i)) oip (osn, kno, val, Suc hops, sip) = rt (σ i)"

          from after have "σ' i = σ i" by simp
          with a5 have "j. σ j = σ' j" by metis

          from a2 have "dipvD (rt (σ i))" by simp
          moreover from a3 have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
            using nochange and j. σ j = σ' j by clarsimp
          moreover from a4 have "the (nhop (rt (σ i)) dip)  dip" by simp
          ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
            using pre by simp

          hence "rt (σ i)dip rt (σ' (the (nhop (rt (σ i)) dip)))"
            using j. σ j = σ' j by simp
          thus "?thesis" by simp
        next
          assume change: "?rt1  rt (σ i)"
          from after a2 have "dipkD(rt (σ' i))" by auto
          show ?thesis
          proof (cases "dip = oip")
            assume "dip  oip"

            with a2 have "dipvD (rt (σ i))" by auto
            moreover with a3 a5 after and dip  oip
              have "dipvD(rt (σ (the (nhop (rt (σ i)) dip))))"
                by simp metis
            moreover from a4 and dip  oip have "the (nhop (rt (σ i)) dip)  dip" by simp
            ultimately have "rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
              using pre by simp

            with after and a5 and dip  oip show ?thesis
              by simp (metis rt_strictly_fresher_update_other
                             rt_strictly_fresher_irefl)
          next
            assume "dip = oip"

            with a4 and change have "sip  oip" by simp
            with a6 have "oipkD(rt (σ sip))"
                     and "osn  nsqn (rt (σ sip)) oip" by auto

            from a3 change dip = oip have "oipvD(rt (σ' sip))" by simp
            hence "the (flag (rt (σ' sip)) oip) = val" by simp

            from oipkD(rt (σ sip))
            have "osn < nsqn (rt (σ' sip)) oip  (osn = nsqn (rt (σ' sip)) oip
                                                    the (dhops (rt (σ' sip)) oip)  hops)"
            proof
              assume "oipvD(rt (σ sip))"
              hence "the (flag (rt (σ sip)) oip) = val" by simp
              with a6 sip  oip have "nsqn (rt (σ sip)) oip = osn 
                                          the (dhops (rt (σ sip)) oip)  hops"
                by simp
              show ?thesis
              proof (cases "sip = i")
                assume "sip  i"
                with a5 have "σ sip = σ' sip" by simp
                with osn  nsqn (rt (σ sip)) oip
                 and ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                show ?thesis by auto
              next
                ― ‹alternative to using @{text sip_not_ip}
                assume [simp]: "sip = i"
                have "?rt1 = rt (σ i)"
                proof (rule update_cases_kD, simp_all)
                  from ‹Suc 0  osn show "0 < osn" by simp
                next
                  from oipkD(rt (σ sip)) and sip = i show "oipkD(rt (σ i))"
                    by simp
                next
                  assume "sqn (rt (σ i)) oip < osn"
                  also from osn  nsqn (rt (σ sip)) oip
                    have "...  nsqn (rt (σ i)) oip" by simp
                  also have "...  sqn (rt (σ i)) oip"
                    by (rule nsqn_sqn)
                  finally have "sqn (rt (σ i)) oip < sqn (rt (σ i)) oip" .
                  hence False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "sqn (rt (σ i)) oip = osn"
                     and "Suc hops < the (dhops (rt (σ i)) oip)"
                  from this(1) and oip  vD (rt (σ sip)) have "nsqn (rt (σ i)) oip = osn"
                    by simp
                  with ‹nsqn (rt (σ sip)) oip = osn  the (dhops (rt (σ sip)) oip)  hops
                    have "the (dhops (rt (σ i)) oip)  hops" by simp
                  with ‹Suc hops < the (dhops (rt (σ i)) oip) have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  assume "the (flag (rt (σ i)) oip) = inv"
                  with ‹the (flag (rt (σ sip)) oip) = val› have False by simp
                  thus "(λa. if a = oip
                             then Some (osn, kno, val, Suc hops, i)
                             else rt (σ i) a) = rt (σ i)" ..
                next
                  from oipkD(rt (σ sip))
                    show "(λa. if a = oip then Some (the (rt (σ i) oip)) else rt (σ i) a) = rt (σ i)"
                      by (auto dest!: kD_Some)
                qed
                with change have False ..
                thus ?thesis ..
              qed
            next
              assume "oipiD(rt (σ sip))"
              with ‹the (flag (rt (σ' sip)) oip) = val› and a5 have "sip = i"
                by (metis f.distinct(1) iD_flag_is_inv)
              from oipiD(rt (σ sip)) have "the (flag (rt (σ sip)) oip) = inv" by auto
              with sip = i ‹Suc 0  osn change after oipkD(rt (σ sip))
                have "nsqn (rt (σ sip)) oip < nsqn (rt (σ' sip)) oip"
                  unfolding update_def
                  by (clarsimp split: option.split_asm if_split_asm)
                     (auto simp: sqn_def)
              with osn  nsqn (rt (σ sip)) oip have "osn < nsqn (rt (σ' sip)) oip"
                by simp
              thus ?thesis ..
            qed
            thus ?thesis
            proof
              assume osnlt: "osn < nsqn (rt (σ' sip)) oip"
              from dipkD(rt (σ' i)) and dip = oip have "dip  kD (?rt1)" by simp
              moreover from a3 have "dip  kD(?rt2 dip)" by simp
              moreover have "nsqn ?rt1 dip < nsqn (?rt2 dip) dip"
                proof -
                  have "nsqn ?rt1 oip = osn"
                    by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                  also have "... < nsqn (rt (σ' sip)) oip" using osnlt .
                  also have  "... = nsqn (?rt2 oip) oip" by (simp add: change)
                  finally show ?thesis
                    using dip = oip by simp
                qed
              ultimately show ?thesis
                by (rule rt_strictly_fresher_ltI)
            next
              assume osneq: "osn = nsqn (rt (σ' sip)) oip  the (dhops (rt (σ' sip)) oip)  hops"

              have "oipkD(?rt1)" by simp
              moreover from a3 dip = oip have "oipkD(?rt2 oip)" by simp

              moreover have "nsqn ?rt1 oip = nsqn (?rt2 oip) oip"
              proof -
                from osneq have "osn = nsqn (rt (σ' sip)) oip" ..
                also have "osn = nsqn ?rt1 oip"
                  by (simp add: dip = oip nsqn_update_changed_kno_val [OF change [THEN not_sym]])
                also have  "nsqn (rt (σ' sip)) oip = nsqn (?rt2 oip) oip"
                  by (simp add: change)
                finally show ?thesis .
              qed

              moreover have "π5(the (?rt2 oip oip)) < π5(the (?rt1 oip))"
              proof -
                from osneq have "the (dhops (rt (σ' sip)) oip)  hops" ..
                moreover from oip  vD (rt (σ' sip)) have "oipkD(rt (σ' sip))" by auto
                ultimately have "π5(the (rt (σ' sip) oip))  hops"
                  by (auto simp add: proj5_eq_dhops)
                also from change after have "hops < π5(the (rt (σ' i) oip))"
                  by (simp add: proj5_eq_dhops) (metis dhops_update_changed lessI)
                finally have "π5(the (rt (σ' sip) oip)) < π5(the (rt (σ' i) oip))" .
                with change after show ?thesis by simp
              qed

              ultimately have "?rt1oip ?rt2 oip"
                by (rule rt_strictly_fresher_eqI)
              with dip = oip show ?thesis by simp
                qed
          qed
       qed
     qed
    } note rreq_rrep_update = this

    have "opaodv i  (otherwith ((=)) {i} (orecvmsg (λσ m. msg_fresh σ m
                                                             msg_zhops m)),
                       other quality_increases {i} →)
            onl ΓAODV
           (λ(σ, _). dip. dip  vD (rt (σ i))  vD (rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                            rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip))))"
      proof (inv_cterms inv add: onl_oinvariant_sterms [OF aodv_wf rreq_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rrep_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf rerr_sip [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf oosn_rreq [THEN weaken]]
                                 onl_oinvariant_sterms [OF aodv_wf odsn_rrep [THEN weaken]]
                        solve: basic update_0_unk invalidate rreq_rrep_update
                        simp add: seqlsimp)
        fix σ σ' p l
        assume or: "(σ, p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
           and "other quality_increases {i} σ σ'"
           and ll: "l  labels ΓAODV p"
           and pre: "dip. dipvD (rt (σ i))
                            dipvD(rt (σ (the (nhop (rt (σ i)) dip))))
                            the (nhop (rt (σ i)) dip)  dip
                         rt (σ i)dip rt (σ (the (nhop (rt (σ i)) dip)))"
        from this(1-2)
          have or': "(σ', p)  oreachable (opaodv i) (?S i)  (other quality_increases {i})"
            by - (rule oreachable_other')

        from or and ll have next_hop: "dip. let nhip = the (nhop (rt (σ i)) dip)
                                             in dip  kD(rt (σ i))  nhip  dip
                                              dip  kD(rt (σ nhip))
                                                  nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip"
          by (auto dest!: onl_oinvariant_weakenD [OF seq_compare_next_hop'])

        from or and ll have unk_hops_one: "dipkD (rt (σ i)). sqn (rt (σ i)) dip = 0
                                                 sqnf (rt (σ i)) dip = unk
                                                     the (dhops (rt (σ i)) dip) = 1
                                                     the (nhop (rt (σ i)) dip) = dip"
          by (auto dest!: onl_oinvariant_weakenD [OF ozero_seq_unk_hops_one
                                                     [OF oaodv_trans aodv_trans]]
                          otherwith_actionD
                          simp: seqlsimp)

        from ‹other quality_increases {i} σ σ' have "σ' i = σ i" by auto
        hence "quality_increases (σ i) (σ' i)" by auto
        with ‹other quality_increases {i} σ σ' have "j. quality_increases (σ j) (σ' j)"
          by - (erule otherE, metis singleton_iff)

        show "dip. dip  vD (rt (σ' i))
                   dip  vD (rt (σ' (the (nhop (rt (σ' i)) dip))))
                   the (nhop (rt (σ' i)) dip)  dip
               rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
        proof clarify
          fix dip
          assume "dipvD(rt (σ' i))"
             and "dipvD(rt (σ' (the (nhop (rt (σ' i)) dip))))"
             and "the (nhop (rt (σ' i)) dip)  dip"
          from this(1) and σ' i = σ i have "dipvD(rt (σ i))"
                                         and "dipkD(rt (σ i))"
            by auto

          from ‹the (nhop (rt (σ' i)) dip)  dip and σ' i = σ i
            have "the (nhop (rt (σ i)) dip)  dip" (is "?nhip  _") by simp
          with dipkD(rt (σ i)) and next_hop
            have "dipkD(rt (σ (?nhip)))"
             and nsqns: "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
               by (auto simp: Let_def)

          have "0 < sqn (rt (σ i)) dip"
            proof (rule neq0_conv [THEN iffD1, OF notI])
              assume "sqn (rt (σ i)) dip = 0"
              with dipkD(rt (σ i)) and unk_hops_one
                have "?nhip = dip" by simp
              with ?nhip  dip show False ..
            qed
          also have "... = nsqn (rt (σ i)) dip"
            by (rule vD_nsqn_sqn [OF dipvD(rt (σ i)), THEN sym])
          also have "...  nsqn (rt (σ ?nhip)) dip"
            by (rule nsqns)
          also have "...  sqn (rt (σ ?nhip)) dip"
            by (rule nsqn_sqn)
          finally have "0 < sqn (rt (σ ?nhip)) dip" .

          have "rt (σ i)dip rt (σ' ?nhip)"
          proof (cases "dipvD(rt (σ ?nhip))")
            assume "dipvD(rt (σ ?nhip))"
            with pre dipvD(rt (σ i)) and ?nhip  dip
              have "rt (σ i)dip rt (σ ?nhip)" by auto
            moreover from j. quality_increases (σ j) (σ' j)
              have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
            ultimately show ?thesis
              using dipkD(rt (σ ?nhip))
              by (rule strictly_fresher_quality_increases_right)
          next
            assume "dipvD(rt (σ ?nhip))"
            with dipkD(rt (σ ?nhip)) have "dipiD(rt (σ ?nhip))" ..
            hence "the (flag (rt (σ ?nhip)) dip) = inv"
              by auto
            have "nsqn (rt (σ i)) dip  nsqn (rt (σ ?nhip)) dip"
              by (rule nsqns)
            also from dipiD(rt (σ ?nhip))
              have "... = sqn (rt (σ ?nhip)) dip - 1" ..
            also have "... < sqn (rt (σ' ?nhip)) dip"
              proof -
                from j. quality_increases (σ j) (σ' j)
                  have "quality_increases (σ ?nhip) (σ' ?nhip)" ..
                hence "ip. sqn (rt (σ ?nhip)) ip  sqn (rt (σ' ?nhip)) ip" by auto
                hence "sqn (rt (σ ?nhip)) dip  sqn (rt (σ' ?nhip)) dip" ..
                with 0 < sqn (rt (σ ?nhip)) dip show ?thesis by auto
              qed
            also have "... = nsqn (rt (σ' ?nhip)) dip"
              proof (rule vD_nsqn_sqn [THEN sym])
                from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
                  show "dipvD(rt (σ' ?nhip))" by simp
              qed
            finally have "nsqn (rt (σ i)) dip < nsqn (rt (σ' ?nhip)) dip" .

            moreover from dipvD(rt (σ' (the (nhop (rt (σ' i)) dip)))) and σ' i = σ i
              have "dipkD(rt (σ' ?nhip))" by auto
            ultimately show "rt (σ i)dip rt (σ' ?nhip)"
              using dipkD(rt (σ i)) by - (rule rt_strictly_fresher_ltI)
          qed
          with σ' i = σ i show "rt (σ' i)dip rt (σ' (the (nhop (rt (σ' i)) dip)))"
            by simp
        qed
      qed
    thus ?thesis unfolding Let_def .
  qed

lemma seq_compare_next_hop:
  fixes w
  shows "opaodv i  (otherwith ((=)) {i} (orecvmsg msg_fresh),
                      other quality_increases {i} →)
                       global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                         in dip  kD(rt (σ i))  nhip  dip 
                                            dip  kD(rt (σ nhip))
                                             nsqn (rt (σ i)) dip  nsqn (rt (σ nhip)) dip)"
  by (rule oinvariant_weakenE [OF seq_compare_next_hop']) (auto dest!: onlD)

lemma seq_nhop_quality_increases:
  shows "opaodv i  (otherwith ((=)) {i}
                        (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                         other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
  by (rule oinvariant_weakenE [OF seq_nhop_quality_increases']) (auto dest!: onlD)

end

Theory E_Loop_Freedom

(*  Title:       variants/e_all_abcd/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "Routing graphs and loop freedom"

theory E_Loop_Freedom
imports E_Aodv_Predicates E_Fresher
begin

text ‹Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.›

definition
  rt_graph :: "(ip  state)  ip  ip rel"
where
  "rt_graph σ = (λdip.
     {(ip, ip') | ip ip' dsn dsk hops.
        ip  dip  rt (σ ip) dip = Some (dsn, dsk, val, hops, ip')})"

text ‹Given the state of a network @{term σ}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).›

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip')  rt_graph σ dip"
    shows "ip  dip  (r. rt (σ ip) = r
                             (dsn dsk hops. r dip = Some (dsn, dsk, val, hops, ip')))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  dip  vD(rt (σ ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  dip  vD(rt (σ ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip  dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "ip ip' σ dip. (ip, ip')  (rt_graph σ dip)+  ip  dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "ip ip' σ dip. (ip, ip')  rt_graph σ dip  ip' = the (nhop (rt (σ ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "i dip. let nhip = the (nhop (rt (σ i)) dip)
                   in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                       (rt (σ i))dip (rt (σ nhip))"
    shows "dip. irrefl ((rt_graph σ dip)+)"
  using assms proof (intro allI)
    fix σ :: "ip  state" and dip
    assume inv: "ip dip.
                  let nhip = the (nhop (rt (σ ip)) dip)
                  in dip  vD(rt (σ ip))  vD(rt (σ nhip)) 
                     nhip  dip  rt (σ ip)dip rt (σ nhip)"
    { fix ip ip'
      assume "(ip, ip')  (rt_graph σ dip)+"
         and "dip  vD(rt (σ ip'))"
         and "ip'  dip"
       hence "rt (σ ip)dip rt (σ ip')"
         proof induction
           fix nhip
           assume "(ip, nhip)  rt_graph σ dip"
              and "dip  vD(rt (σ nhip))"
              and "nhip  dip"
           from (ip, nhip)  rt_graph σ dip have "dip  vD(rt (σ ip))"
                                               and "nhip = the (nhop (rt (σ ip)) dip)"
             by auto
           from dip  vD(rt (σ ip)) and dip  vD(rt (σ nhip))
             have "dip  vD(rt (σ ip))  vD(rt (σ nhip))" ..
           with nhip = the (nhop (rt (σ ip)) dip)
                and nhip  dip
                and inv
             show "rt (σ ip)dip rt (σ nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip)  (rt_graph σ dip)+"
              and "(nhip, nhip')  rt_graph σ dip"
              and IH: " dip  vD(rt (σ nhip)); nhip  dip   rt (σ ip)dip rt (σ nhip)"
              and "dip  vD(rt (σ nhip'))"
              and "nhip'  dip"
           from (nhip, nhip')  rt_graph σ dip have 1: "dip  vD(rt (σ nhip))"
                                                  and 2: "nhip  dip"
                                                  and "nhip' = the (nhop (rt (σ nhip)) dip)"
             by auto
           from 1 2 have "rt (σ ip)dip rt (σ nhip)" by (rule IH)
           also have "rt (σ nhip)dip rt (σ nhip')"
             proof -
               from dip  vD(rt (σ nhip)) and dip  vD(rt (σ nhip'))
                 have "dip  vD(rt (σ nhip))  vD(rt (σ nhip'))" ..
               with nhip'  dip
                    and nhip' = the (nhop (rt (σ nhip)) dip)
                    and inv
                 show "rt (σ nhip)dip rt (σ nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (σ ip)dip rt (σ nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph σ dip)+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip)  (rt_graph σ dip)+"
      moreover then have "dip  vD(rt (σ ip))"
                     and "ip  dip"
        by auto
      ultimately have "rt (σ ip)dip rt (σ ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end

Theory E_Aodv_Loop_Freedom

(*  Title:       variants/e_all_abcd/Aodv_Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Lift and transfer invariants to show loop freedom"

theory E_Aodv_Loop_Freedom
imports AWN.OClosed_Transfer AWN.Qmsg_Lifting E_Global_Invariants E_Loop_Freedom
begin

subsection ‹Lift to parallel processes with queues›

lemma par_step_no_change_on_send_or_receive:
    fixes σ s a σ' s'
  assumes "((σ, s), a, (σ', s'))  oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG)"
      and "a  τ"
    shows "σ' i = σ i"
  using assms by (rule qmsg_no_change_on_send_or_receive)

lemma par_nhop_quality_increases:
  shows "opaodv i ⟨⟨i qmsg  (otherwith ((=)) {i} (orecvmsg (λσ m.
                                    msg_fresh σ m  msg_zhops m)),
                                  other quality_increases {i} →)
                        global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                              (rt (σ i))dip (rt (σ nhip)))"
    proof (rule lift_into_qmsg [OF seq_nhop_quality_increases])
    show "opaodv i A (otherwith ((=)) {i}
                         (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)),
                        other quality_increases {i} →)
                       globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
    proof (rule ostep_invariant_weakenE [OF oquality_increases], simp_all)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "onll ΓAODV (λ((σ, _), _, (σ', _)). j. quality_increases (σ j) (σ' j)) t"
      thus "quality_increases (fst (fst t) i) (fst (snd (snd t)) i)"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    next
      fix σ σ' a
      assume "otherwith ((=)) {i}
                (orecvmsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      thus "otherwith quality_increases {i} (orecvmsg (λ_. rreq_rrep_sn)) σ σ' a"
        by - (erule weaken_otherwith, auto)
    qed
  qed auto

lemma par_rreq_rrep_sn_quality_increases:
  "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  proof -
    have "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF olocal_quality_increases])
         (auto dest!: onllD seqllD elim!: aodv_ex_labelE)
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                   globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_rreq_rrep_nsqn_fresh_any_step:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ,
                                   other (λ_ _. True) {i} →)
                                  globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
  proof -
    have "opaodv i A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                       globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
    proof (rule ostep_invariant_weakenE [OF rreq_rrep_nsqn_fresh_any_step_invariant])
      fix t
      assume "onll ΓAODV (λ((σ, _), a, _). anycast (msg_fresh σ) a) t"
      thus "globala (λ(σ, a, σ'). anycast (msg_fresh σ) a) t"
        by (cases t) (clarsimp dest!: onllD, metis aodv_ex_label)
    qed auto
    hence "opaodv i ⟨⟨i qmsg A (λσ _. (orecvmsg (λ_. rreq_rrep_sn)) σ, other (λ_ _. True) {i} →)
                                    globala (λ(σ, a, σ'). anycast (msg_fresh σ) a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

lemma par_anycast_msg_zhops:
  shows "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                  globala (λ(_, a, _). anycast msg_zhops a)"
  proof -
    from anycast_msg_zhops initiali_aodv oaodv_trans aodv_trans
      have "opaodv i A (act TT, other (λ_ _. True) {i} →)
                         seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a))"
        by (rule open_seq_step_invariant)
    hence "opaodv i A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                            globala (λ(_, a, _). anycast msg_zhops a)"
    proof (rule ostep_invariant_weakenE)
      fix t :: "(((nat  state) × (state, msg, pseqp, pseqp label) seqp), msg seq_action) transition"
      assume "seqll i (onll ΓAODV (λ(_, a, _). anycast msg_zhops a)) t"
      thus "globala (λ(_, a, _). anycast msg_zhops a) t"
        by (cases t) (clarsimp dest!: seqllD onllD, metis aodv_ex_label)
    qed simp_all
    hence "opaodv i ⟨⟨i qmsg A (λσ _. orecvmsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
                                     globala (λ(_, a, _). anycast msg_zhops a)"
      by (rule lift_step_into_qmsg_statelessassm) simp_all
    thus ?thesis by rule auto
  qed

subsection ‹Lift to nodes›

lemma node_step_no_change_on_send_or_receive:
  assumes "((σ, NodeS i P R), a, (σ', NodeS i' P' R'))  onode_sos
                                      (oparp_sos i (oseqp_sos ΓAODV i) (seqp_sos ΓQMSG))"
      and "a  τ"
    shows "σ' i = σ i"
  using assms
  by (cases a) (auto elim!: par_step_no_change_on_send_or_receive)

lemma node_nhop_quality_increases:
  shows " i : opaodv i ⟨⟨i qmsg : R o 
           (otherwith ((=)) {i}
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
              other quality_increases {i}
            →) global (λσ. dip. let nhip = the (nhop (rt (σ i)) dip)
                                  in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                      (rt (σ i))dip (rt (σ nhip)))"
  by (rule node_lift [OF par_nhop_quality_increases]) auto

lemma node_quality_increases:
  " i : opaodv i ⟨⟨i qmsg : R o A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                         other (λ_ _. True) {i} →)
                            globala (λ(σ, _, σ'). quality_increases (σ i) (σ' i))"
  by (rule node_lift_step_statelessassm [OF par_rreq_rrep_sn_quality_increases]) simp

lemma node_rreq_rrep_nsqn_fresh_any_step:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). castmsg (msg_fresh σ) a)"
  by (rule node_lift_anycast_statelessassm [OF par_rreq_rrep_nsqn_fresh_any_step])

lemma node_anycast_msg_zhops:
  shows " i : opaodv i ⟨⟨i qmsg : R o A
          (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ, other (λ_ _. True) {i} →)
          globala (λ(_, a, _). castmsg msg_zhops a)"
  by (rule node_lift_anycast_statelessassm [OF par_anycast_msg_zhops])

lemma node_silent_change_only:
  shows " i : opaodv i ⟨⟨i qmsg : Ri o A (λσ _. oarrivemsg (λ_ _. True) σ,
                                               other (λ_ _. True) {i} →)
          globala (λ(σ, a, σ'). a  τ  σ' i = σ i)"
  proof (rule ostep_invariantI, simp (no_asm), rule impI)
    fix σ ζ a σ' ζ'
    assume or: "(σ, ζ)  oreachable (i : opaodv i ⟨⟨i qmsg : Rio)
                                    (λσ _. oarrivemsg (λ_ _. True) σ)
                                    (other (λ_ _. True) {i})"
      and tr: "((σ, ζ), a, (σ', ζ'))  trans (i : opaodv i ⟨⟨i qmsg : Rio)"
      and "a  τn"
    from or obtain p R where "ζ = NodeS i p R"
      by - (drule node_net_state, metis)
    with tr have "((σ, NodeS i p R), a, (σ', ζ'))
                      onode_sos (oparp_sos i (trans (opaodv i)) (trans qmsg))"
      by simp
    thus "σ' i = σ i" using a  τn 
      by (cases rule: onode_sos.cases)
         (auto elim: qmsg_no_change_on_send_or_receive)
  qed

subsection ‹Lift to partial networks›

lemma arrive_rreq_rrep_nsqn_fresh_inc_sn [simp]:
  assumes "oarrivemsg (λσ m. msg_fresh σ m  P σ m) σ m"
    shows "oarrivemsg (λ_. rreq_rrep_sn) σ m"
  using assms by (cases m) auto

lemma opnet_nhop_quality_increases:
  shows "opnet (λi. opaodv i ⟨⟨i qmsg) p 
           (otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)),
               other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  proof (rule pnet_lift [OF node_nhop_quality_increases])
    fix i R
    have "i : opaodv i ⟨⟨i qmsg : Ro A (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ,
                                              other (λ_ _. True) {i} →) globala (λ(σ, a, σ').
            castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
    proof (rule ostep_invariantI, simp (no_asm))
      fix σ s a σ' s'
      assume or: "(σ, s)  oreachable (i : opaodv i ⟨⟨i qmsg : Ro)
                                      (λσ _. oarrivemsg (λ_. rreq_rrep_sn) σ)
                                      (other (λ_ _. True) {i})"
         and tr: "((σ, s), a, (σ', s'))  trans (i : opaodv i ⟨⟨i qmsg : Ro)"
         and am: "oarrivemsg (λ_. rreq_rrep_sn) σ a"
      from or tr am have "castmsg (msg_fresh σ) a"
        by (auto dest!: ostep_invariantD [OF node_rreq_rrep_nsqn_fresh_any_step])
      moreover from or tr am have "castmsg (msg_zhops) a"
        by (auto dest!: ostep_invariantD [OF node_anycast_msg_zhops])
      ultimately show "castmsg (λm. msg_fresh σ m  msg_zhops m) a"
        by (case_tac a) auto
    qed
    thus "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, _).
               castmsg (λm. msg_fresh σ m  msg_zhops m) a)"
      by rule auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a  τ  (d. a  i:deliver(d))  σ i = σ' i)"
      by (rule ostep_invariant_weakenE [OF node_silent_change_only]) auto
  next
    fix i R
    show "i : opaodv i ⟨⟨i qmsg : Ro A
            (λσ _. oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ,
             other quality_increases {i} →) globala (λ(σ, a, σ').
               a = τ  (d. a = i:deliver(d))  quality_increases (σ i) (σ' i))"
      by (rule ostep_invariant_weakenE [OF node_quality_increases]) auto
  qed simp_all

subsection ‹Lift to closed networks›

lemma onet_nhop_quality_increases:
  shows "oclosed (opnet (λi. opaodv i ⟨⟨i qmsg) p)
            (λ_ _ _. True, other quality_increases (net_tree_ips p) →)
              global (λσ. inet_tree_ips p. dip.
                          let nhip = the (nhop (rt (σ i)) dip)
                          in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                              (rt (σ i))dip (rt (σ nhip)))"
  (is "_  (_, ?U →) ?inv")
  proof (rule inclosed_closed)
    from opnet_nhop_quality_increases
      show "opnet (λi. opaodv i ⟨⟨i qmsg) p
                (otherwith ((=)) (net_tree_ips p) inoclosed, ?U →) ?inv"
    proof (rule oinvariant_weakenE)
      fix σ σ' :: "ip  state" and a :: "msg node_action"
      assume "otherwith ((=)) (net_tree_ips p) inoclosed σ σ' a"
      thus "otherwith ((=)) (net_tree_ips p)
              (oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m)) σ σ' a"
      proof (rule otherwithEI)
        fix σ :: "ip  state" and a :: "msg node_action"
        assume "inoclosed σ a"
        thus "oarrivemsg (λσ m. msg_fresh σ m  msg_zhops m) σ a"
        proof (cases a)
          fix ii ni ms
          assume "a = ii¬ni:arrive(ms)"
          moreover with ‹inoclosed σ a obtain d di where "ms = newpkt(d, di)"
            by (cases ms) auto
          ultimately show ?thesis by simp
        qed simp_all
      qed
    qed
  qed

subsection ‹Transfer into the standard model›

interpretation aodv_openproc: openproc paodv opaodv id
  rewrites "aodv_openproc.initmissing = initmissing"
  proof -
    show "openproc paodv opaodv id"
    proof unfold_locales
      fix i :: ip
      have "{(σ, ζ). (σ i, ζ)  σAODV i  (j. j  i  σ j  fst ` σAODV j)}  σAODV'"
        unfolding σAODV_def σAODV'_def
        proof (rule equalityD1)
          show "f p. {(σ, ζ). (σ i, ζ)  {(f i, p)}  (j. j  i
                       σ j  fst ` {(f j, p)})} = {(f, p)}"
            by (rule set_eqI) auto
        qed
      thus "{ (σ, ζ) |σ ζ s. s  init (paodv i)
                              (σ i, ζ) = id s
                              (j. ji  σ j  (fst o id) ` init (paodv j)) }  init (opaodv i)"
        by simp
    next
      show "j. init (paodv j)  {}"
        unfolding σAODV_def by simp
    next
      fix i s a s' σ σ'
      assume "σ i = fst (id s)"
         and "σ' i = fst (id s')"
         and "(s, a, s')  trans (paodv i)"
      then obtain q q' where "s = (σ i, q)"
                         and "s' = (σ' i, q')"
                         and "((σ i, q), a, (σ' i, q'))  trans (paodv i)" 
         by (cases s, cases s') auto
      from this(3) have "((σ, q), a, (σ', q'))  trans (opaodv i)"
        by simp (rule open_seqp_action [OF aodv_wf])

      with s = (σ i, q) and s' = (σ' i, q')
        show "((σ, snd (id s)), a, (σ', snd (id s')))  trans (opaodv i)"
          by simp
    qed
    then interpret opn: openproc paodv opaodv id .
    have [simp]: "i. (SOME x. x  (fst o id) ` init (paodv i)) = aodv_init i"
      unfolding σAODV_def by simp
    hence "i. openproc.initmissing paodv id i = initmissing i"
      unfolding opn.initmissing_def opn.someinit_def initmissing_def
      by (auto split: option.split)
    thus "openproc.initmissing paodv id = initmissing" ..
  qed

interpretation aodv_openproc_par_qmsg: openproc_parq paodv opaodv id qmsg
  rewrites "aodv_openproc_par_qmsg.netglobal = netglobal"
    and "aodv_openproc_par_qmsg.initmissing = initmissing"
  proof -
    show "openproc_parq paodv opaodv id qmsg"
      by (unfold_locales) simp
    then interpret opq: openproc_parq paodv opaodv id qmsg .

    have im: "σ. openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) σ
                                                                                    = initmissing σ"
      unfolding opq.initmissing_def opq.someinit_def initmissing_def
      unfolding σAODV_def σQMSG_def by (clarsimp cong: option.case_cong)
    thus "openproc.initmissing (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = initmissing"
      by (rule ext)
    have "P σ. openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) P σ
                                                                                = netglobal P σ"
      unfolding opq.netglobal_def netglobal_def opq.initmissing_def initmissing_def opq.someinit_def
      unfolding σAODV_def σQMSG_def
      by (clarsimp cong: option.case_cong
                   simp del: One_nat_def
                   simp add: fst_initmissing_netgmap_default_aodv_init_netlift
                                                  [symmetric, unfolded initmissing_def])
    thus "openproc.netglobal (λi. paodv i ⟨⟨ qmsg) (λ(p, q). (fst (id p), snd (id p), q)) = netglobal"
      by auto
  qed

lemma net_nhop_quality_increases:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal
                           (λσ. i dip. let nhip = the (nhop (rt (σ i)) dip)
                                        in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                             (rt (σ i))dip (rt (σ nhip)))"
        (is "_  netglobal (λσ. i. ?inv σ i)")
  proof -
    from ‹wf_net_tree n
      have proto: "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. inet_tree_ips n. dip.
                                            let nhip = the (nhop (rt (σ i)) dip)
                                            in dip  vD (rt (σ i))  vD (rt (σ nhip))  nhip  dip
                                                 (rt (σ i))dip (rt (σ nhip)))"
        by (rule aodv_openproc_par_qmsg.close_opnet [OF _ onet_nhop_quality_increases])
    show ?thesis
    unfolding invariant_def opnet_sos.opnet_tau1
    proof (rule, simp only: aodv_openproc_par_qmsg.netglobalsimp
                            fst_initmissing_netgmap_pair_fst, rule allI)
      fix σ i
      assume sr: "σ  reachable (closed (pnet (λi. paodv i ⟨⟨ qmsg) n)) TT"
      hence "inet_tree_ips n. ?inv (fst (initmissing (netgmap fst σ))) i"
        by - (drule invariantD [OF proto],
              simp only: aodv_openproc_par_qmsg.netglobalsimp
                         fst_initmissing_netgmap_pair_fst)
      thus "?inv (fst (initmissing (netgmap fst σ))) i"
      proof (cases "inet_tree_ips n")
        assume "inet_tree_ips n"
        from sr have "σ  reachable (pnet (λi. paodv i ⟨⟨ qmsg) n) TT" ..
        hence "net_ips σ = net_tree_ips n" ..
        with inet_tree_ips n have "inet_ips σ" by simp
        hence "(fst (initmissing (netgmap fst σ))) i = aodv_init i"
          by simp
        thus ?thesis by simp
      qed metis
    qed
  qed

subsection ‹Loop freedom of AODV›

theorem aodv_loop_freedom:
  assumes "wf_net_tree n"
  shows "closed (pnet (λi. paodv i ⟨⟨ qmsg) n)  netglobal (λσ. dip. irrefl ((rt_graph σ dip)+))"
  using assms by (rule aodv_openproc_par_qmsg.netglobal_weakenE
                          [OF net_nhop_quality_increases inv_to_loop_freedom])

end

Theory All

(*  Title:       All.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

theory %invisible All
imports Aodv_Loop_Freedom
  "variants/a_norreqid/A_Aodv_Loop_Freedom"
  "variants/b_fwdrreps/B_Aodv_Loop_Freedom"
  "variants/c_gtobcast/C_Aodv_Loop_Freedom"
  "variants/d_fwdrreqs/D_Aodv_Loop_Freedom"
  "variants/e_all_abcd/E_Aodv_Loop_Freedom"
begin

end %invisible